lily/translator-def.cc

   1 /*
   2   translator-def.cc --  implement Translator_def
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2000--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9
  10 #include "lily-proto.hh"
  11 #include "translator-def.hh"
  12 #include "translator-group.hh"
  13 #include "warn.hh"
  14 #include "music-output-def.hh"
  15 #include "ly-smobs.icc"
  16
  17 int
  18 Translator_def::print_smob (SCM smob, SCM port, scm_print_state*)
  19 {
  20   Translator_def* me = (Translator_def*) SCM_CELL_WORD_1 (smob);
  21
  22   scm_puts ("#<Translator_def ", port);
  23   scm_display (me->type_name_, port);
  24   scm_puts (">", port);
  25   return 1;
  26 }
  27
  28
  29 SCM
  30 Translator_def::mark_smob (SCM smob)
  31 {
  32   Translator_def* me = (Translator_def*) SCM_CELL_WORD_1 (smob);
  33
  34   scm_gc_mark (me->type_aliases_);
  35   scm_gc_mark (me->consists_name_list_);
  36   scm_gc_mark (me->accepts_name_list_);
  37   scm_gc_mark (me->end_consists_name_list_);
  38   scm_gc_mark (me->property_ops_);
  39   scm_gc_mark (me->translator_group_type_);
  40   return me->type_name_;
  41 }
  42
  43
  44 Translator_def::Translator_def ()
  45 {
  46   type_aliases_ = SCM_EOL;
  47   translator_group_type_ = SCM_EOL;
  48   accepts_name_list_ = SCM_EOL;
  49   consists_name_list_ = SCM_EOL;
  50   end_consists_name_list_ = SCM_EOL;
  51   property_ops_ = SCM_EOL;
  52   type_name_ = SCM_EOL;
  53
  54   smobify_self();
  55
  56 }
  57
  58 Translator_def::~Translator_def ()
  59 {
  60 }
  61
  62 Translator_def::Translator_def (Translator_def const & s)
  63   : Input (s)
  64 {
  65   type_aliases_ = SCM_EOL;
  66   translator_group_type_ = SCM_EOL;
  67   accepts_name_list_ = SCM_EOL;
  68   consists_name_list_ = SCM_EOL;
  69   end_consists_name_list_ = SCM_EOL;
  70   property_ops_ = SCM_EOL;
  71   type_name_ = SCM_EOL;
  72
  73
  74   smobify_self();
  75   consists_name_list_ = scm_list_copy (s.consists_name_list_);
  76   end_consists_name_list_ = scm_list_copy (s.end_consists_name_list_);
  77   accepts_name_list_ = scm_list_copy (s.accepts_name_list_);
  78   property_ops_ = scm_list_copy (s.property_ops_);
  79   type_aliases_ = scm_list_copy (s.type_aliases_);
  80   translator_group_type_ = s.translator_group_type_;
  81   type_name_ = s.type_name_;
  82 }
  83
  84
  85
  86 void
  87 Translator_def::set_acceptor (SCM name, bool add)
  88 {
  89   if (add)
  90     this->accepts_name_list_ = gh_cons (name, this->accepts_name_list_);
  91   else
  92     this->accepts_name_list_ = scm_delete_x (name, this->accepts_name_list_);
  93 }
  94
  95
  96 SCM
  97 Translator_def::modify_definition (SCM list, SCM str, bool add)
  98 {
  99   String s = ly_scm2string (str);
 100   if (!get_translator (s))
 101     error (_ ("Program has no such type"));
 102
 103   if (add)
 104     {
 105       if (scm_memq (str, list) != SCM_BOOL_F)
 106         {
 107           warning (_f ("Already contains: `%s'", s));
 108           warning (_f ("Not adding translator: `%s'", s));
 109         }
 110       else
 111         list= gh_cons (str, list);
 112     }
 113   else
 114     {
 115       list = scm_delete_x (str, list);
 116     }
 117   return list;
 118 }
 119
 120
 121
 122 void
 123 Translator_def::remove_element (SCM s)
 124 {
 125   this->end_consists_name_list_ = modify_definition (this->end_consists_name_list_, s, false);
 126   this->consists_name_list_ = modify_definition (this->consists_name_list_, s, false);
 127 }
 128
 129 void
 130 Translator_def::add_element (SCM s)
 131 {
 132   this->consists_name_list_ = modify_definition (this->consists_name_list_, s, true);
 133 }
 134
 135 void
 136 Translator_def::add_last_element (SCM s)
 137 {
 138   this->end_consists_name_list_ = modify_definition (this->end_consists_name_list_, s, true);
 139 }
 140 void
 141 Translator_def::add_push_property (SCM props, SCM syms,  SCM vals)
 142 {
 143   this->property_ops_ = gh_cons (scm_list_n (ly_symbol2scm ("push"), props, syms, vals, SCM_UNDEFINED),
 144                                  this->property_ops_);
 145 }
 146
 147 void
 148 Translator_def::add_pop_property (SCM props, SCM syms)
 149 {
 150   this->property_ops_ = gh_cons (scm_list_n (ly_symbol2scm ("push"), props, syms, SCM_UNDEFINED),
 151                                  this->property_ops_);
 152 }
 153
 154 /*
 155   Do it. SYM is single symbol. VAL is SCM_UNDEFINED in case of a pop
 156 */
 157 void
 158 Translator_def::apply_pushpop_property (Translator_group* me,SCM sym, SCM eprop, SCM val)
 159 {
 160   dynamic_cast<Translator_group*> (me)
 161     ->execute_single_pushpop_property (sym, eprop, val);
 162 }
 163
 164
 165
 166 Link_array<Translator_def>
 167 Translator_def::path_to_acceptable_translator (SCM type_string, Music_output_def* odef) const
 168 {
 169   assert (gh_string_p (type_string));
 170
 171   Link_array<Translator_def> accepteds;
 172   for (SCM s = accepts_name_list_; gh_pair_p (s); s = ly_cdr (s))
 173     {
 174       Translator_def *t = unsmob_translator_def (odef->find_translator (ly_car (s)));
 175       if (!t)
 176         continue;
 177       accepteds.push (t);
 178     }
 179
 180   Link_array<Translator_def> best_result;
 181   for (int i=0; i < accepteds.size (); i++)
 182     {
 183
 184       /*
 185         don't check aliases, because \context Staff should not create RhythmicStaff.
 186       */
 187       if (gh_equal_p (accepteds[i]->type_name_, type_string))
 188         {
 189           best_result.push (accepteds[i]);
 190           return best_result;
 191         }
 192     }
 193
 194   int best_depth= INT_MAX;
 195   for (int i=0; i < accepteds.size (); i++)
 196     {
 197       Translator_def * g = accepteds[i];
 198
 199       Link_array<Translator_def> result
 200         = g->path_to_acceptable_translator (type_string, odef);
 201       if (result.size () && result.size () < best_depth)
 202         {
 203           result.insert (g,0);
 204           best_result = result;
 205         }
 206     }
 207
 208   return best_result;
 209 }
 210
 211 IMPLEMENT_SMOBS (Translator_def);
 212 IMPLEMENT_DEFAULT_EQUAL_P (Translator_def);
 213
 214
 215 static SCM
 216 trans_list (SCM namelist, Translator_group*tg)
 217 {
 218   SCM l = SCM_EOL;
 219   for (SCM s = namelist; gh_pair_p (s) ; s = ly_cdr (s))
 220     {
 221       Translator * t = get_translator (ly_scm2string (ly_car (s)));
 222       if (!t)
 223         warning (_f ("can't find: `%s'", s));
 224       else
 225         {
 226           Translator * tr = t->clone ();
 227           SCM str = tr->self_scm ();
 228           l = gh_cons (str, l);
 229
 230           tr->daddy_trans_ = tg;
 231           tr->output_def_  = tg->output_def_;
 232
 233           scm_gc_unprotect_object (str);
 234         }
 235     }
 236   return l;
 237 }
 238
 239
 240 Translator_group *
 241 Translator_def::instantiate (Music_output_def* md)
 242 {
 243   Translator * g = get_translator (ly_scm2string (translator_group_type_));
 244   g = g->clone ();
 245
 246   Translator_group *tg = dynamic_cast<Translator_group*> (g);
 247   tg->output_def_ = md;
 248   tg->definition_ = self_scm ();
 249   tg->type_string_ = ly_scm2string (type_name_);
 250
 251   /*
 252     TODO: ugh. we're reversing CONSISTS_NAME_LIST_ here
 253    */
 254   SCM l1 = trans_list (consists_name_list_, tg);
 255   SCM l2 =trans_list (end_consists_name_list_,tg);
 256   l1 = scm_reverse_x (l1, l2);
 257
 258   tg->simple_trans_list_ = l1;
 259
 260   return tg;
 261 }
 262
 263
 264 void
 265 Translator_def::apply_property_operations (Translator_group*tg)
 266 {
 267   SCM correct_order = scm_reverse (property_ops_); // pity of the mem.
 268   for (SCM s = correct_order; gh_pair_p (s); s = ly_cdr (s))
 269     {
 270       SCM entry = ly_car (s);
 271       SCM type = ly_car (entry);
 272       entry = ly_cdr (entry);
 273
 274       if (type == ly_symbol2scm ("push"))
 275         {
 276           SCM val = ly_cddr (entry);
 277           val = gh_pair_p (val) ? ly_car (val) : SCM_UNDEFINED;
 278
 279           apply_pushpop_property (tg, ly_car (entry), ly_cadr (entry), val);
 280         }
 281       else if (type == ly_symbol2scm ("assign"))
 282         {
 283           tg->internal_set_property (ly_car (entry), ly_cadr (entry));
 284         }
 285     }
 286 }
 287
 288 SCM
 289 Translator_def::clone_scm () const
 290 {
 291   Translator_def * t = new Translator_def (*this);
 292   scm_gc_unprotect_object (t->self_scm());
 293   return t->self_scm();
 294 }
 295
 296 SCM
 297 Translator_def::make_scm ()
 298 {
 299   Translator_def* t = new Translator_def;
 300   scm_gc_unprotect_object (t->self_scm());
 301   return t->self_scm();
 302 }
 303
 304 void
 305 Translator_def::add_property_assign (SCM nm, SCM val)
 306 {
 307   this->property_ops_ = gh_cons (scm_list_n (ly_symbol2scm ("assign"), scm_string_to_symbol (nm), val, SCM_UNDEFINED),
 308                                  this->property_ops_);
 309 }
 310
 311 /*
 312   Default child context as a SCM string, or something else if there is
 313   none.
 314 */
 315 SCM
 316 Translator_def::default_child_context_name ()
 317 {
 318   SCM d = accepts_name_list_;
 319   return gh_pair_p (d) ? ly_car (scm_last_pair (d)) : SCM_EOL;
 320 }
 321
 322 SCM
 323 Translator_def::to_alist () const
 324 {
 325   SCM l = SCM_EOL;
 326
 327   l = gh_cons (gh_cons (ly_symbol2scm ("consists"),  consists_name_list_), l);
 328   l = gh_cons (gh_cons (ly_symbol2scm ("end-consists"),  end_consists_name_list_), l);
 329   l = gh_cons (gh_cons (ly_symbol2scm ("accepts"),  accepts_name_list_), l);
 330   l = gh_cons (gh_cons (ly_symbol2scm ("property-ops"),  property_ops_), l);
 331   l = gh_cons (gh_cons (ly_symbol2scm ("type-name"),  type_name_), l); // junkme.
 332   l = gh_cons (gh_cons (ly_symbol2scm ("group-type"),  translator_group_type_), l);
 333
 334   return l;
 335 }