2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2004--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
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.
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.
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/>.
21 #include "engraver.hh"
22 #include "global-context.hh"
23 #include "international.hh"
26 #include "simple-closure.hh"
28 #include "unpure-pure-container.hh"
32 like execute_general_pushpop_property(), but typecheck
33 grob_property_path and context_property.
36 general_pushpop_property (Context *context,
38 SCM grob_property_path,
41 if (!scm_is_symbol (context_property)
42 || !scm_is_symbol (scm_car (grob_property_path)))
44 warning (_ ("need symbol arguments for \\override and \\revert"));
45 if (do_internal_type_checking_global)
49 sloppy_general_pushpop_property (context, context_property,
50 grob_property_path, new_value);
54 typecheck_grob (SCM symbol, SCM value)
56 if (is_unpure_pure_container (value))
57 return typecheck_grob (symbol, unpure_pure_container_unpure_part (value))
58 && typecheck_grob (symbol, unpure_pure_container_pure_part (value));
59 return ly_is_procedure (value)
60 || is_simple_closure (value)
61 || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?"));
65 Grob descriptions (ie. alists with layout properties) are
66 represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
67 alist defined in a parent context. BASED-ON should always be a tail
70 Push or pop (depending on value of VAL) a single entry from a
71 translator property list by name of PROP. GROB_PROPERTY_PATH
72 indicates nested alists, eg. '(beamed-stem-lengths details)
75 execute_override_property (Context *context,
77 SCM grob_property_path,
80 SCM current_context_val = SCM_EOL;
82 if (!context->here_defined (context_property, ¤t_context_val))
84 Context *g = context->get_global_context ();
86 return; // Context is probably dead
92 || !g->here_defined (context_property, ¤t_context_val))
95 /* where != context */
97 SCM base = updated_grob_properties (context->get_parent_context (),
99 current_context_val = scm_cons (base, base);
100 context->set_property (context_property, current_context_val);
103 if (!scm_is_pair (current_context_val))
105 programming_error ("Grob definition should be cons");
109 SCM target_alist = scm_car (current_context_val);
111 SCM symbol = scm_car (grob_property_path);
112 if (scm_is_pair (scm_cdr (grob_property_path)))
114 new_value = nested_property_alist (ly_assoc_get (symbol, target_alist,
116 scm_cdr (grob_property_path),
120 /* it's tempting to replace the head of the list if it's the same
121 property. However, we have to keep this info around, in case we have to
124 target_alist = scm_acons (symbol, new_value, target_alist);
128 tack onto alist. We can use set_car, since
129 updated_grob_properties () in child contexts will check
130 for changes in the car.
132 if (typecheck_grob (symbol, new_value))
134 scm_set_car_x (current_context_val, target_alist);
139 do a pop (indicated by new_value==SCM_UNDEFINED) or push
142 sloppy_general_pushpop_property (Context *context,
143 SCM context_property,
144 SCM grob_property_path,
147 if (new_value == SCM_UNDEFINED)
148 execute_revert_property (context, context_property,
151 execute_override_property (context, context_property,
157 Revert the property given by property_path.
160 execute_revert_property (Context *context,
161 SCM context_property,
162 SCM grob_property_path)
164 SCM current_context_val = SCM_EOL;
165 if (context->here_defined (context_property, ¤t_context_val))
167 SCM current_alist = scm_car (current_context_val);
168 SCM daddy = scm_cdr (current_context_val);
170 if (!scm_is_pair (grob_property_path)
171 || !scm_is_symbol (scm_car (grob_property_path)))
173 programming_error ("Grob property path should be list of symbols.");
177 SCM symbol = scm_car (grob_property_path);
178 if (scm_is_pair (scm_cdr (grob_property_path)))
180 SCM current_sub_alist = ly_assoc_get (symbol, current_alist, SCM_EOL);
182 = nested_property_revert_alist (current_sub_alist,
183 scm_cdr (grob_property_path));
185 if (scm_is_pair (current_alist)
186 && scm_caar (current_alist) == symbol
187 && current_alist != daddy)
188 current_alist = scm_cdr (current_alist);
190 current_alist = scm_acons (symbol, new_val, current_alist);
191 scm_set_car_x (current_context_val, current_alist);
195 SCM new_alist = evict_from_alist (symbol, current_alist, daddy);
197 if (new_alist == daddy)
198 context->unset_property (context_property);
200 context->set_property (context_property,
201 scm_cons (new_alist, daddy));
206 Convenience: a push/pop grob property using a single grob_property
210 execute_pushpop_property (Context *context,
211 SCM context_property,
215 general_pushpop_property (context, context_property,
216 scm_list_1 (grob_property),
221 PRE_INIT_OPS is in the order specified, and hence must be reversed.
224 apply_property_operations (Context *tg, SCM pre_init_ops)
226 for (SCM s = pre_init_ops; scm_is_pair (s); s = scm_cdr (s))
228 SCM entry = scm_car (s);
229 SCM type = scm_car (entry);
230 entry = scm_cdr (entry);
232 if (type == ly_symbol2scm ("push"))
234 SCM context_prop = scm_car (entry);
235 SCM val = scm_cadr (entry);
236 SCM grob_prop_path = scm_cddr (entry);
237 sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val);
239 else if (type == ly_symbol2scm ("pop"))
241 SCM context_prop = scm_car (entry);
242 SCM val = SCM_UNDEFINED;
243 SCM grob_prop_path = scm_cdr (entry);
244 sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val);
246 else if (type == ly_symbol2scm ("assign"))
247 tg->set_property (scm_car (entry), scm_cadr (entry));
248 else if (type == ly_symbol2scm ("apply"))
249 scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry));
250 else if (type == ly_symbol2scm ("unset"))
251 tg->unset_property (scm_car (entry));
256 Return the object alist for SYM, checking if its base in enclosing
257 contexts has changed. The alist is updated if necessary.
260 updated_grob_properties (Context *tg, SCM sym)
262 assert (scm_is_symbol (sym));
265 tg = tg->where_defined (sym, &props);
270 = (tg->get_parent_context ())
271 ? updated_grob_properties (tg->get_parent_context (), sym)
274 if (!scm_is_pair (props))
276 programming_error ("grob props not a pair?");
280 SCM based_on = scm_cdr (props);
281 if (based_on == daddy_props)
282 return scm_car (props);
285 SCM copy = daddy_props;
287 SCM p = scm_car (props);
288 while (p != based_on)
290 *tail = scm_cons (scm_car (p), daddy_props);
291 tail = SCM_CDRLOC (*tail);
295 scm_set_car_x (props, copy);
296 scm_set_cdr_x (props, daddy_props);