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