]> git.donarmstrong.com Git - lilypond.git/blob - lily/context-def.cc
* lily/include/lily-guile.hh: compatibility glue for 1.6
[lilypond.git] / lily / context-def.cc
1 /*   
2   translator-def.cc --  implement Context_def
3
4   source file of the GNU LilyPond music typesetter
5
6   (c) 2000--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
7 */
8
9 /* TODO: should junk this class an replace by
10    a single list of context modifications?  */
11
12 #include "context-def.hh"
13 #include "engraver.hh"
14 #include "lily-proto.hh"
15 #include "output-def.hh"
16 #include "performer.hh"
17 #include "score-context.hh"
18 #include "translator-group.hh"
19 #include "warn.hh"
20
21 Context_def::Context_def ()
22 {
23   context_aliases_ = SCM_EOL;
24   translator_group_type_ = SCM_EOL;
25   accept_mods_ = SCM_EOL;
26   translator_mods_ = SCM_EOL;
27   property_ops_ = SCM_EOL;
28   context_name_ = SCM_EOL;
29   description_ = SCM_EOL;
30
31   smobify_self ();
32
33   context_name_ = ly_symbol2scm ("");
34 }
35
36 Context_def::Context_def (Context_def const & s)
37   : Input (s)
38 {
39   context_aliases_ = SCM_EOL;
40   translator_group_type_ = SCM_EOL;
41   accept_mods_ = SCM_EOL;   
42   translator_mods_ = SCM_EOL;
43   property_ops_ = SCM_EOL;
44   context_name_ = SCM_EOL;
45   description_ = SCM_EOL;
46   
47   smobify_self ();
48   description_ = s.description_;
49
50   accept_mods_ = s.accept_mods_;
51   property_ops_ = s.property_ops_;
52   translator_mods_ = s.translator_mods_;
53   context_aliases_ = s.context_aliases_;
54   translator_group_type_ = s.translator_group_type_;
55   context_name_ = s.context_name_;
56 }
57
58 Context_def::~Context_def ()
59 {
60 }
61
62 #include "ly-smobs.icc"
63 IMPLEMENT_SMOBS (Context_def);
64 IMPLEMENT_DEFAULT_EQUAL_P (Context_def);
65
66 int
67 Context_def::print_smob (SCM smob, SCM port, scm_print_state*)
68 {
69   Context_def* me = (Context_def*) SCM_CELL_WORD_1 (smob);
70
71   scm_puts ("#<Context_def ", port);
72   scm_display (me->context_name_, port);
73   scm_puts (">", port);
74   return 1;
75 }
76
77 SCM
78 Context_def::mark_smob (SCM smob)
79 {
80   Context_def* me = (Context_def*) SCM_CELL_WORD_1 (smob);
81
82   scm_gc_mark (me->description_);
83   scm_gc_mark (me->context_aliases_);
84   scm_gc_mark (me->accept_mods_);
85   scm_gc_mark (me->translator_mods_);
86   scm_gc_mark (me->property_ops_);  
87   scm_gc_mark (me->translator_group_type_);
88
89   return me->context_name_;
90 }
91
92 void
93 Context_def::add_context_mod (SCM mod)
94 {
95   SCM tag = ly_car (mod);
96   if (ly_symbol2scm ("description") == tag)
97     {
98       description_ = ly_cadr (mod);
99       return;
100     }
101
102   SCM sym = ly_cadr (mod);
103   if (scm_is_string (sym))
104     sym = scm_string_to_symbol (sym);
105   
106   if (ly_symbol2scm ("consists") == tag
107       || ly_symbol2scm ("consists-end") == tag
108       || ly_symbol2scm ("remove") == tag)
109     {
110       if (!get_translator (sym))
111         error (_f ("Program has no such type: `%s'",
112                    ly_symbol2string (sym).to_str0 ()));
113       else
114         translator_mods_ = scm_cons (scm_list_2 (tag, sym), translator_mods_);
115     }
116   else if (ly_symbol2scm ("accepts") == tag
117            || ly_symbol2scm ("denies") == tag)
118     accept_mods_ = scm_cons (scm_list_2 (tag, sym), accept_mods_); 
119   else if (ly_symbol2scm ("poppush") == tag
120            || ly_symbol2scm ("pop") == tag
121            || ly_symbol2scm ("push") == tag
122            || ly_symbol2scm ("assign") == tag
123            || ly_symbol2scm ("unset") == tag)
124     property_ops_ = scm_cons (mod, property_ops_);
125   else if (ly_symbol2scm ("alias") == tag)
126     context_aliases_ = scm_cons (sym, context_aliases_);
127   else if (ly_symbol2scm ("translator-type")  == tag)
128     translator_group_type_ = sym;
129   else if (ly_symbol2scm ("context-name")  == tag)
130     context_name_ = sym;
131   else
132     programming_error ("Unknown context mod tag.");
133 }
134
135 SCM
136 Context_def::get_context_name () const
137 {
138   return context_name_;
139 }
140
141 SCM
142 Context_def::get_accepted (SCM user_mod) const
143 {
144   SCM mods = scm_reverse_x (scm_list_copy (accept_mods_), user_mod);
145   SCM acc = SCM_EOL;
146   for (SCM s = mods; ly_c_pair_p (s); s = ly_cdr (s))
147     {
148       SCM tag = ly_caar (s);
149       SCM sym = ly_cadar (s);
150       if (tag == ly_symbol2scm ("accepts"))
151         acc = scm_cons (sym, acc);
152       else if (tag == ly_symbol2scm ("denies"))
153         acc = scm_delete_x (sym, acc);
154     }
155   return acc;
156 }
157
158 Link_array<Context_def>
159 Context_def::path_to_acceptable_context (SCM type_sym, Output_def *odef) const
160 {
161   assert (ly_c_symbol_p (type_sym));
162   
163   SCM accepted = get_accepted (SCM_EOL);
164
165   Link_array<Context_def> accepteds;
166   for (SCM s = accepted; ly_c_pair_p (s); s = ly_cdr (s))
167     if (Context_def *t = unsmob_context_def (find_context_def (odef,
168                                                                ly_car (s))))
169       accepteds.push (t);
170
171   Link_array<Context_def> best_result;
172   for (int i=0; i < accepteds.size (); i++)
173     {
174       /* do not check aliases, because \context Staff should not
175          create RhythmicStaff. */
176       if (ly_c_equal_p (accepteds[i]->get_context_name (), type_sym))
177         {
178           best_result.push (accepteds[i]);
179           return best_result;
180         }
181     }
182
183   int best_depth= INT_MAX;
184   for (int i=0; i < accepteds.size (); i++)
185     {
186       Context_def * g = accepteds[i];
187
188       Link_array<Context_def> result
189         = g->path_to_acceptable_context (type_sym, odef);
190       if (result.size () && result.size () < best_depth)
191         {
192           result.insert (g,0);
193           best_result = result;
194
195           /* this following line was added in 1.9.3, but hsould've been
196              there all along... Let's hope it doesn't cause nightmares.  */
197           best_depth = result.size ();
198         }
199     }
200
201   return best_result;
202 }
203
204 SCM
205 Context_def::get_translator_names (SCM user_mod) const
206 {
207   SCM l1 = SCM_EOL;
208
209   SCM mods = scm_reverse_x (scm_list_copy (translator_mods_), user_mod);
210   
211   for (SCM s = mods; ly_c_pair_p (s); s = ly_cdr (s))
212     {
213       SCM tag = ly_caar (s);
214       SCM arg = ly_cadar (s);
215
216       if (scm_is_string (arg))
217         arg = scm_string_to_symbol (arg);
218       
219       if (ly_symbol2scm ("consists") == tag)
220         l1 = scm_cons (arg, l1);
221       else if (ly_symbol2scm ("remove") == tag)
222         {
223           l1 = scm_delete_x (arg, l1);
224         }
225     }
226
227   return l1;
228 }
229
230 SCM
231 filter_performers (SCM ell)
232 {
233   for (SCM *tail = &ell; ly_c_pair_p (*tail); tail = SCM_CDRLOC (*tail))
234     {
235       if (dynamic_cast<Performer*> (unsmob_translator (ly_car (*tail))))
236         {
237           *tail = ly_cdr (*tail);
238           if (!ly_c_pair_p (*tail))
239             break ;
240         }
241     }
242   return ell;
243 }
244
245 SCM
246 filter_engravers (SCM ell)
247 {
248   SCM *tail = &ell;  
249   for (; ly_c_pair_p (*tail) ; tail = SCM_CDRLOC (*tail))
250     {
251       if (dynamic_cast<Engraver*> (unsmob_translator (ly_car (*tail))))
252         {
253           *tail = ly_cdr (*tail);
254           if (!ly_c_pair_p (*tail))
255             break ;
256         }
257     }
258   return ell;
259 }
260
261
262 Context *
263 Context_def::instantiate (SCM ops)
264 {
265   Context *tg =  0;
266
267   if (context_name_ == ly_symbol2scm ("Score"))
268     tg = new Score_context ();
269   else
270     tg = new Context ();
271
272   tg->definition_ = self_scm ();
273
274   SCM trans_names = get_translator_names (ops); 
275
276   Translator *g = get_translator (translator_group_type_);
277   g = g->clone ();
278
279   SCM trans_list = SCM_EOL;
280   
281   for (SCM s = trans_names; ly_c_pair_p (s) ; s = ly_cdr (s))
282     {
283       Translator *t = get_translator (ly_car (s));
284       if (!t)
285         warning (_f ("can't find: `%s'", s));
286       else
287         {
288           Translator *tr = t->clone ();
289           SCM str = tr->self_scm ();
290
291           if (tr->must_be_last ())
292             {
293               SCM cons = scm_cons (str, SCM_EOL);
294               if (ly_c_pair_p (trans_list))
295                 scm_set_cdr_x (scm_last_pair (trans_list), cons);
296               else
297                 trans_list= cons;
298             }
299           else
300             {
301               trans_list = scm_cons (str, trans_list);
302             }
303
304           tr->daddy_context_ = tg;
305           scm_gc_unprotect_object (str);
306         }
307     }
308   
309   g->simple_trans_list_ =  trans_list;
310
311   tg->implementation_ = g->self_scm ();
312   if (dynamic_cast<Engraver*> (g))
313     g->simple_trans_list_ = filter_performers (g->simple_trans_list_);
314   else if (dynamic_cast<Performer*> (g))
315     g->simple_trans_list_ = filter_engravers (g->simple_trans_list_);
316         
317   g->daddy_context_ = tg;
318   tg->aliases_ = context_aliases_ ;
319   
320   scm_gc_unprotect_object (g->self_scm ());
321   
322   tg->accepts_list_ = get_accepted  (ops);
323   
324   return tg;
325 }
326
327 SCM
328 Context_def::clone_scm () const
329 {
330   Context_def * t = new Context_def (*this);
331   SCM x = t->self_scm ();
332   scm_gc_unprotect_object (x);
333   return x;
334 }
335
336 SCM
337 Context_def::make_scm ()
338 {
339   Context_def* t = new Context_def;
340   SCM x = t->self_scm ();
341   scm_gc_unprotect_object (x);
342   return x;
343 }
344
345 void
346 Context_def::apply_default_property_operations (Context *tg)
347 {
348   apply_property_operations (tg, property_ops_);
349 }
350
351 SCM
352 Context_def::to_alist () const
353 {
354   SCM ell = SCM_EOL;
355
356   ell = scm_cons (scm_cons (ly_symbol2scm ("consists"),
357                             get_translator_names (SCM_EOL)), ell);
358   ell = scm_cons (scm_cons (ly_symbol2scm ("description"), description_), ell);
359   ell = scm_cons (scm_cons (ly_symbol2scm ("aliases"), context_aliases_), ell);
360   ell = scm_cons (scm_cons (ly_symbol2scm ("accepts"), get_accepted (SCM_EOL)),
361                   ell);
362   ell = scm_cons (scm_cons (ly_symbol2scm ("property-ops"), property_ops_),
363                   ell);
364   ell = scm_cons (scm_cons (ly_symbol2scm ("context-name"), context_name_),
365                   ell);
366
367   if (ly_c_symbol_p (translator_group_type_))
368     ell = scm_cons (scm_cons (ly_symbol2scm ("group-type"),
369                               translator_group_type_), ell);    
370   return ell;  
371 }
372