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