]> git.donarmstrong.com Git - lilypond.git/blob - lily/context-property.cc
Release: bump VERSION_DEVEL.
[lilypond.git] / lily / context-property.cc
1 /*
2   This file is part of LilyPond, the GNU music typesetter.
3
4   Copyright (C) 2004--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
5
6   LilyPond is free software: you can redistribute it and/or modify
7   it under the terms of the GNU General Public License as published by
8   the Free Software Foundation, either version 3 of the License, or
9   (at your option) any later version.
10
11   LilyPond is distributed in the hope that it will be useful,
12   but WITHOUT ANY WARRANTY; without even the implied warranty of
13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14   GNU General Public License for more details.
15
16   You should have received a copy of the GNU General Public License
17   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
18 */
19
20 #include "context.hh"
21 #include "engraver.hh"
22 #include "global-context.hh"
23 #include "grob-properties.hh"
24 #include "international.hh"
25 #include "item.hh"
26 #include "main.hh"
27 #include "simple-closure.hh"
28 #include "smobs.hh"
29 #include "spanner.hh"
30 #include "unpure-pure-container.hh"
31 #include "warn.hh"
32
33 /*
34   like execute_general_pushpop_property(), but typecheck
35   grob_property_path and context_property.
36 */
37 void
38 general_pushpop_property (Context *context,
39                           SCM context_property,
40                           SCM grob_property_path,
41                           SCM new_value)
42 {
43   if (!scm_is_symbol (context_property)
44       || !scm_is_symbol (scm_car (grob_property_path)))
45     {
46       warning (_ ("need symbol arguments for \\override and \\revert"));
47       if (do_internal_type_checking_global)
48         assert (false);
49     }
50
51   Grob_property_info (context, context_property).pushpop
52     (grob_property_path, new_value);
53 }
54
55 bool
56 typecheck_grob (SCM symbol, SCM value)
57 {
58   if (Unpure_pure_container *upc = Unpure_pure_container::unsmob (value))
59     return typecheck_grob (symbol, upc->unpure_part ())
60       && typecheck_grob (symbol, upc->pure_part ());
61   return ly_is_procedure (value)
62     || Simple_closure::unsmob (value)
63     || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?"));
64 }
65
66 class Grob_properties : public Simple_smob<Grob_properties>
67 {
68 public:
69   static int print_smob (SCM, SCM, scm_print_state *);
70   static SCM mark_smob (SCM);
71   static const char type_p_name_[];
72 private:
73   friend class Grob_property_info;
74   friend SCM ly_make_grob_properties (SCM);
75   // alist_ may contain unexpanded nested overrides
76   SCM alist_;
77   // based_on_ is the cooked_ value from the next higher context that
78   // alist_ is based on
79   SCM based_on_;
80   // cooked_ is a version of alist_ where nested overrides have been
81   // expanded
82   SCM cooked_;
83   // cooked_from_ is the value of alist_ from which the expansion has
84   // been done
85   SCM cooked_from_;
86   // nested_ is a count of nested overrides in alist_
87   int nested_;
88
89   Grob_properties (SCM alist, SCM based_on) :
90     alist_ (alist), based_on_ (based_on),
91     // if the constructor was called with lists possibly containing
92     // partial overrides, we would need to initialize with based_on in
93     // order to trigger an initial update.  But this should never
94     // happen, so we initialize straight with alist.
95     cooked_ (alist), cooked_from_ (alist), nested_ (0) { }
96 };
97
98 const char Grob_properties::type_p_name_[] = "ly:grob-properties?";
99
100 SCM
101 Grob_properties::mark_smob (SCM smob)
102 {
103   Grob_properties *gp = (Grob_properties *) SCM_SMOB_DATA (smob);
104   scm_gc_mark (gp->alist_);
105   scm_gc_mark (gp->based_on_);
106   scm_gc_mark (gp->cooked_);
107   return gp->cooked_from_;
108 }
109
110 int
111 Grob_properties::print_smob (SCM /*smob*/, SCM port, scm_print_state *)
112 {
113   scm_puts ("#<Grob_properties>", port);
114
115   return 1;
116 }
117
118 LY_DEFINE (ly_make_grob_properties, "ly:make-grob-properties",
119            1, 0, 0, (SCM alist),
120            "This packages the given property list @var{alist} in"
121            " a grob property container stored in a context property"
122            " with the name of a grob.")
123 {
124   LY_ASSERT_TYPE (ly_is_list, alist, 1);
125   return Grob_properties (alist, SCM_EOL).smobbed_copy ();
126 }
127
128
129 Grob_property_info
130 Grob_property_info::find ()
131 {
132   if (props_)
133     return *this;
134   SCM res = SCM_UNDEFINED;
135   if (Context *c = context_->where_defined (symbol_, &res))
136     if (c != context_)
137       return Grob_property_info (c, symbol_, Grob_properties::unsmob (res));
138   props_  = Grob_properties::unsmob (res);
139   return *this;
140 }
141
142 bool
143 Grob_property_info::check ()
144 {
145   if (props_)
146     return true;
147   SCM res = SCM_UNDEFINED;
148   if (context_->here_defined (symbol_, &res))
149     props_ = Grob_properties::unsmob (res);
150   return props_;
151 }
152
153 bool
154 Grob_property_info::create ()
155 {
156   // Using scm_hashq_create_handle_x would seem like the one-lookup
157   // way to create a handle if it does not exist yet.  However, we
158   // need to check that there is a corresponding grob in this
159   // particular output first, and we have to do this in the global
160   // context.  By far the most frequent case will be that a
161   // Grob_properties for this context already exists, so we optimize
162   // for that and only check the global handle when the local
163   // context is pristine.
164   if (check ())
165     return true;
166   SCM current_context_val = SCM_EOL;
167   Context *g = context_->get_global_context ();
168   if (!g)
169     return false; // Context is probably dead
170
171   /*
172     Don't mess with MIDI.
173   */
174   if (g == context_
175       || !g->here_defined (symbol_, &current_context_val))
176     return false;
177
178   Grob_properties *def = Grob_properties::unsmob (current_context_val);
179
180   if (!def)
181     {
182       programming_error ("Grob definition expected");
183       return false;
184     }
185
186   // We create the new Grob_properties from the default definition
187   // since this is what we have available right now.  It may or may
188   // not be accurate since we don't take into account any
189   // prospective overrides in intermediate contexts.  If there are
190   // any, they will be factored in when `updated' is being called.
191   SCM props = Grob_properties (def->alist_, def->alist_).smobbed_copy ();
192   context_->set_property (symbol_, props);
193   props_ = Grob_properties::unsmob (props);
194   return props_;
195 }
196
197 /*
198   Grob descriptions (ie. alists with layout properties) are
199   represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
200   alist defined in a parent context. BASED-ON should always be a tail
201   of ALIST.
202
203   Push or pop (depending on value of VAL) a single entry from a
204   translator property list by name of PROP.  GROB_PROPERTY_PATH
205   indicates nested alists, eg. '(beamed-stem-lengths details)
206 */
207 void
208 Grob_property_info::push (SCM grob_property_path, SCM new_value)
209 {
210   /*
211     Don't mess with MIDI.
212   */
213   if (!create ())
214     return;
215
216   SCM symbol = scm_car (grob_property_path);
217   SCM rest = scm_cdr (grob_property_path);
218   if (scm_is_pair (rest))
219     {
220       // poor man's typechecking
221       if (typecheck_grob (symbol, nested_create_alist (rest, new_value))) {
222         props_->alist_ = scm_acons (grob_property_path, new_value, props_->alist_);
223         props_->nested_++;
224       }
225       return;
226     }
227
228   /* it's tempting to replace the head of the list if it's the same
229    property. However, we have to keep this info around, in case we have to
230    \revert back to it.
231   */
232
233   if (typecheck_grob (symbol, new_value))
234     props_->alist_ = scm_acons (symbol, new_value, props_->alist_);
235 }
236
237 /*
238   Revert the property given by property_path.
239 */
240 void
241 Grob_property_info::pop (SCM grob_property_path)
242 {
243   if (!check ())
244     return;
245
246   SCM current_alist = props_->alist_;
247   SCM daddy = props_->based_on_;
248
249   if (!scm_is_pair (grob_property_path)
250       || !scm_is_symbol (scm_car (grob_property_path)))
251     {
252       programming_error ("Grob property path should be list of symbols.");
253       return;
254     }
255
256   if (scm_is_pair (scm_cdr (grob_property_path)))
257     {
258       SCM old_alist = current_alist;
259       current_alist = evict_from_alist (grob_property_path, current_alist, daddy);
260       if (scm_is_eq (old_alist, current_alist))
261         return;
262       props_->nested_--;
263     }
264   else
265     current_alist = evict_from_alist (scm_car (grob_property_path),
266                                       current_alist, daddy);
267
268   if (scm_is_eq (current_alist, daddy))
269     {
270       assert (props_->nested_ == 0);
271       props_ = 0;
272       context_->unset_property (symbol_);
273       return;
274     }
275   props_->alist_ = current_alist;
276 }
277 /*
278   Convenience: a push/pop grob property using a single grob_property
279   as argument.
280 */
281 void
282 execute_pushpop_property (Context *context,
283                           SCM grob,
284                           SCM grob_property,
285                           SCM new_value)
286 {
287   Grob_property_info (context, grob).pushpop (scm_list_1 (grob_property), new_value);
288 }
289
290 /*
291   PRE_INIT_OPS is in the order specified, and hence must be reversed.
292 */
293 void
294 apply_property_operations (Context *tg, SCM pre_init_ops)
295 {
296   for (SCM s = pre_init_ops; scm_is_pair (s); s = scm_cdr (s))
297     {
298       SCM entry = scm_car (s);
299       SCM type = scm_car (entry);
300       entry = scm_cdr (entry);
301
302       if (type == ly_symbol2scm ("push"))
303         {
304           SCM context_prop = scm_car (entry);
305           SCM val = scm_cadr (entry);
306           SCM grob_prop_path = scm_cddr (entry);
307           Grob_property_info (tg, context_prop).push (grob_prop_path, val);
308         }
309       else if (type == ly_symbol2scm ("pop"))
310         {
311           SCM context_prop = scm_car (entry);
312           SCM grob_prop_path = scm_cdr (entry);
313           Grob_property_info (tg, context_prop).pop (grob_prop_path);
314         }
315       else if (type == ly_symbol2scm ("assign"))
316         tg->set_property (scm_car (entry), scm_cadr (entry));
317       else if (type == ly_symbol2scm ("apply"))
318         scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry));
319       else if (type == ly_symbol2scm ("unset"))
320         tg->unset_property (scm_car (entry));
321     }
322 }
323
324 /*
325   Return the object alist for SYM, checking if its base in enclosing
326   contexts has changed. The alist is updated if necessary.
327 */
328 SCM Grob_property_info::updated ()
329 {
330   assert (scm_is_symbol (symbol_));
331
332   Grob_property_info where = find ();
333
334   if (!where)
335     return SCM_EOL;
336
337   Context *dad = where.context_->get_parent_context ();
338
339   SCM daddy_props
340     = dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL;
341
342   SCM based_on = where.props_->based_on_;
343   SCM alist = where.props_->alist_;
344   if (!scm_is_eq (based_on, daddy_props))
345     {
346       where.props_->based_on_ = daddy_props;
347       alist = partial_list_copy (alist, based_on, daddy_props);
348       where.props_->alist_ = alist;
349     }
350   if (scm_is_eq (where.props_->cooked_from_, alist))
351     return where.props_->cooked_;
352   where.props_->cooked_from_ = alist;
353   where.props_->cooked_ = nalist_to_alist (alist, where.props_->nested_);
354   return where.props_->cooked_;
355 }