]> git.donarmstrong.com Git - lilypond.git/blob - lily/context.cc
* lily/context-selector.cc (set_tweaks): New function.
[lilypond.git] / lily / context.cc
1 /*   
2   context.cc --  implement Context
3
4   source file of the GNU LilyPond music typesetter
5
6   (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
7
8 */
9
10 #include "context-def.hh"
11 #include "context-selector.hh"
12 #include "context.hh"
13 #include "ly-smobs.icc"
14 #include "main.hh"
15 #include "output-def.hh"
16 #include "scm-hash.hh"
17 #include "score-context.hh"
18 #include "translator-group.hh"
19 #include "warn.hh"
20
21 bool
22 Context::is_removable () const
23 {
24   return context_list_ == SCM_EOL && ! iterator_count_ &&
25           !dynamic_cast<Score_context const*> (this);
26 }
27
28 void
29 Context::check_removal ()
30 {
31   for (SCM p = context_list_; scm_is_pair (p); p = scm_cdr (p))
32     {
33       Context *trg = unsmob_context (scm_car (p));
34
35       trg->check_removal ();
36       if (trg->is_removable ())
37         {
38           recurse_over_translators (trg, &Translator::finalize, UP);
39           remove_context (trg);
40         }
41     }
42 }
43
44 Context::Context (Context const&)
45 {
46   assert (false);
47 }
48
49 Scheme_hash_table *
50 Context::properties_dict () const
51 {
52   return Scheme_hash_table::unsmob (properties_scm_);
53 }
54
55 void
56 Context::add_context (Context *t)
57 {
58   SCM ts = t->self_scm ();
59   context_list_ = ly_append2 (context_list_,
60                               scm_cons (ts, SCM_EOL));
61   
62   t->daddy_context_ = this;
63   if (!t->init_)
64     {
65       t->init_ = true;
66 #ifdef TWEAK 
67       Context_selector::register_context (t);
68 #endif  
69       scm_gc_unprotect_object (ts);
70       Context_def *td = unsmob_context_def (t->definition_);
71
72       /*
73         this can not move before add_context (), because \override
74         operations require that we are in the hierarchy.
75       */
76       td->apply_default_property_operations (t);
77
78       recurse_over_translators (t, &Translator::initialize, DOWN);
79     }
80 }
81
82 Context::Context ()
83 {
84   daddy_context_ = 0;
85   init_ = false;
86   aliases_ = SCM_EOL;
87   iterator_count_  = 0;
88   implementation_ = SCM_EOL;
89   properties_scm_ = SCM_EOL;
90   accepts_list_ = SCM_EOL;
91   context_list_ = SCM_EOL;
92   definition_ = SCM_EOL;
93   
94   smobify_self ();
95
96   properties_scm_ = (new Scheme_hash_table)->self_scm ();
97   scm_gc_unprotect_object (properties_scm_);
98 }
99
100
101
102 Context*
103 Context::find_create_context (SCM n, String id,
104                               SCM operations)
105 {
106   /*
107     Don't create multiple score contexts.
108    */
109   if (dynamic_cast<Global_context*> (this)
110       && dynamic_cast<Global_context*> (this)->get_score_context ())
111     return get_score_context ()->find_create_context (n, id, operations);
112     
113   
114   Context * existing = find_context_below (this, n,id);
115   if (existing)
116     return existing;
117
118   if (n == ly_symbol2scm ("Bottom"))
119     {
120       Context* tg = get_default_interpreter ();
121       tg->id_string_ = id;
122       return tg;
123     }
124
125   /*
126     TODO: use accepts_list_.
127    */
128   Link_array<Context_def> path
129     = unsmob_context_def (definition_)->path_to_acceptable_context (n, get_output_def ());
130
131   if (path.size ())
132     {
133       Context * current = this;
134
135       // start at 1.  The first one (index 0) will be us.
136       for (int i=0; i < path.size (); i++)
137         {
138           SCM ops = (i == path.size () -1) ? operations : SCM_EOL;
139
140           Context * new_group
141             = path[i]->instantiate (ops);
142
143           if (i == path.size () -1)
144             {
145               new_group->id_string_ = id;
146             }
147
148           current->add_context (new_group);
149           apply_property_operations (new_group, ops);
150           
151           current = new_group;
152         }
153
154       return current;
155     }
156
157   /*
158     Don't go up to Global_context, because global goes down to
159     Score_context
160    */
161   Context *ret = 0;
162   if (daddy_context_ && !dynamic_cast<Global_context*> (daddy_context_))
163     ret = daddy_context_->find_create_context (n, id, operations);
164   else
165     {
166       warning (_f ("Cannot find or create `%s' called `%s'",
167                    ly_symbol2string (n).to_str0 (), id));
168       ret =0;
169     }
170   return ret;
171 }
172
173 /*
174   Default child context as a SCM string, or something else if there is
175   none.
176 */
177 SCM
178 Context::default_child_context_name () const
179 {
180   return scm_is_pair (accepts_list_)
181     ? scm_car (scm_last_pair (accepts_list_))
182     : SCM_EOL;
183 }
184
185
186 bool
187 Context::is_bottom_context () const
188 {
189   return !scm_is_symbol (default_child_context_name ());
190 }
191
192 Context*
193 Context::get_default_interpreter ()
194 {
195   if (!is_bottom_context ())
196     {
197       SCM nm = default_child_context_name ();
198       SCM st = find_context_def (get_output_def (), nm);
199
200       Context_def *t = unsmob_context_def (st);
201       if (!t)
202         {
203           warning (_f ("can't find or create: `%s'", ly_symbol2string (nm).to_str0 ()));
204           t = unsmob_context_def (this->definition_);
205         }
206       Context *tg = t->instantiate (SCM_EOL);
207       add_context (tg);
208       if (!tg->is_bottom_context ())
209         return tg->get_default_interpreter ();
210       else
211         return tg;
212     }
213   return this;
214 }
215
216 /*
217   PROPERTIES
218  */
219 Context*
220 Context::where_defined (SCM sym) const
221 {
222   if (properties_dict ()->contains (sym))
223     {
224       return (Context*)this;
225     }
226
227   return (daddy_context_) ? daddy_context_->where_defined (sym) : 0;
228 }
229
230 /*
231   return SCM_EOL when not found.
232 */
233 SCM
234 Context::internal_get_property (SCM sym) const
235 {
236   SCM val = SCM_EOL;
237   if (properties_dict ()->try_retrieve (sym, &val))
238     return val;
239
240   if (daddy_context_)
241     return daddy_context_->internal_get_property (sym);
242   
243   return val;
244 }
245
246 bool
247 Context::is_alias (SCM sym) const
248 {
249   if (sym == ly_symbol2scm ("Bottom")
250       && !scm_is_pair (accepts_list_))
251     return true;
252   if (sym == unsmob_context_def (definition_)->get_context_name ())
253     return true;
254   
255   return scm_c_memq (sym, aliases_) != SCM_BOOL_F;
256 }
257
258 void
259 Context::add_alias (SCM sym)
260 {
261   aliases_ = scm_cons (sym, aliases_);
262 }
263
264
265
266 void
267 Context::internal_set_property (SCM sym, SCM val)
268 {
269 #ifndef NDEBUG
270   if (internal_type_checking_global_b)
271     assert (type_check_assignment (sym, val, ly_symbol2scm ("translation-type?")));
272 #endif
273   
274   properties_dict ()->set (sym, val);
275 }
276
277 /*
278   TODO: look up to check whether we have inherited var? 
279  */
280 void
281 Context::unset_property (SCM sym)
282 {
283   properties_dict ()->remove (sym);
284 }
285
286 /**
287    Remove a context from the hierarchy.
288  */
289 Context *
290 Context::remove_context (Context*trans)
291 {
292   assert (trans);
293
294   context_list_ = scm_delq_x (trans->self_scm (), context_list_);
295   trans->daddy_context_ = 0;
296   return trans;
297 }
298
299 /*
300   ID == "" means accept any ID.
301  */
302 Context *
303 find_context_below (Context * where,
304                     SCM type, String id)
305 {
306   if (where->is_alias (type))
307     {
308       if (id == "" || where->id_string () == id)
309         return where;
310     }
311   
312   Context *found = 0;
313   for (SCM s = where->children_contexts ();
314        !found && scm_is_pair (s); s = scm_cdr (s))
315     {
316       Context *tr = unsmob_context (scm_car (s));
317
318       found = find_context_below (tr, type, id);
319     }
320
321   return found; 
322 }
323
324 SCM
325 Context::properties_as_alist () const
326 {
327   return properties_dict ()->to_alist ();
328 }
329
330 SCM
331 Context::context_name_symbol () const
332 {
333   Context_def *td = unsmob_context_def (definition_);
334   return td->get_context_name ();
335 }
336
337 String
338 Context::context_name () const
339 {
340   return ly_symbol2string (context_name_symbol ());
341 }
342
343 Score_context*
344 Context::get_score_context () const
345 {
346   if (Score_context *sc = dynamic_cast<Score_context*> ((Context*) this))
347     return sc;
348   else if (daddy_context_)
349     return daddy_context_->get_score_context ();
350   else
351     return 0;
352 }
353
354 Output_def *
355 Context::get_output_def () const
356 {
357   return daddy_context_ ? daddy_context_->get_output_def () : 0;
358 }
359
360 Context::~Context ()
361 {
362   
363 }
364
365 Moment
366 Context::now_mom () const
367 {
368   return daddy_context_->now_mom ();
369 }
370
371 int
372 Context::print_smob (SCM s, SCM port, scm_print_state *)
373 {
374   Context *sc = (Context *) SCM_CELL_WORD_1 (s);
375      
376   scm_puts ("#<", port);
377   scm_puts (classname (sc), port);
378   if (Context_def *d = unsmob_context_def (sc->definition_))
379     {
380       scm_puts (" ", port);
381       scm_display (d->get_context_name (), port);
382     }
383
384   if (Context *td=dynamic_cast<Context *> (sc))
385     {
386       scm_puts ("=", port);
387       scm_puts (td->id_string_.to_str0 (), port);
388     }
389   
390
391   scm_puts (" ", port);
392
393   scm_display (sc->context_list_, port);
394   scm_puts (" >", port);
395   
396   return 1;
397 }
398
399 SCM
400 Context::mark_smob (SCM sm)
401 {
402   Context *me = (Context*) SCM_CELL_WORD_1 (sm);
403   
404   scm_gc_mark (me->context_list_);
405   scm_gc_mark (me->aliases_);
406   scm_gc_mark (me->definition_);  
407   scm_gc_mark (me->properties_scm_);  
408   scm_gc_mark (me->accepts_list_);
409   scm_gc_mark (me->implementation_);
410
411   return me->properties_scm_;
412 }
413
414 IMPLEMENT_SMOBS (Context);
415 IMPLEMENT_DEFAULT_EQUAL_P (Context);
416 IMPLEMENT_TYPE_P (Context,"ly:context?");
417
418 bool
419 Context::try_music (Music* m)
420 {
421   Translator*  t = implementation ();
422   if (!t)
423     return false;
424   
425   bool b = t->try_music (m);
426   if (!b && daddy_context_)
427     b = daddy_context_->try_music (m);
428
429   return b;
430 }
431
432
433 Global_context*
434 Context::get_global_context () const
435 {
436   if (dynamic_cast<Global_context *>((Context*) this))
437     return dynamic_cast<Global_context *> ((Context*) this);
438
439   if (daddy_context_)
440     return daddy_context_->get_global_context ();
441
442   programming_error ("No Global context!");
443   return 0;
444 }
445
446 Context*
447 Context::get_parent_context () const
448 {
449   return daddy_context_;
450 }
451
452 Translator_group*
453 Context::implementation () const
454 {
455   return dynamic_cast<Translator_group*> (unsmob_translator (implementation_));
456 }