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--2001 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
  16 #include "ly-smobs.icc"
  17
  18 int
  19 Translator_def::print_smob (SCM smob, SCM port, scm_print_state*)
  20 {
  21   Translator_def* me = (Translator_def*) SCM_CELL_WORD_1 (smob);
  22
  23   scm_puts ("#<Translator_def ", port);
  24   scm_display (me->type_name_, port);
  25   scm_puts (">", port);
  26   return 1;
  27 }
  28
  29
  30 SCM
  31 Translator_def::mark_smob (SCM smob)
  32 {
  33   Translator_def* me = (Translator_def*) SCM_CELL_WORD_1 (smob);
  34
  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 SCM push_sym;
  45 SCM assign_sym;
  46
  47 static void
  48 foo_init ()
  49 {
  50   push_sym = scm_permanent_object (ly_symbol2scm ("push"));
  51   assign_sym = scm_permanent_object (ly_symbol2scm ("assign"));
  52 }
  53
  54 ADD_SCM_INIT_FUNC (transdef, foo_init);
  55
  56 Translator_def::Translator_def ()
  57 {
  58   type_aliases_ = SCM_EOL;
  59   translator_group_type_ = SCM_EOL;
  60   accepts_name_list_ = SCM_EOL;
  61   consists_name_list_ = SCM_EOL;
  62   end_consists_name_list_ = SCM_EOL;
  63   property_ops_ = SCM_EOL;
  64   type_name_ = SCM_EOL;
  65 }
  66 Translator_def::~Translator_def ()
  67 {
  68 }
  69
  70 Translator_def::Translator_def (Translator_def const & s)
  71   : Input (s)
  72 {
  73   consists_name_list_ = scm_list_copy (s.consists_name_list_);
  74   end_consists_name_list_ = scm_list_copy (s.end_consists_name_list_);
  75   accepts_name_list_ = scm_list_copy (s.accepts_name_list_);
  76   property_ops_ = scm_list_copy (s.property_ops_);
  77   type_aliases_ = s.type_aliases_;
  78   translator_group_type_ = s.translator_group_type_;
  79   type_name_ = s.type_name_;
  80 }
  81
  82
  83
  84 void
  85 Translator_def::set_acceptor (SCM name, bool add)
  86 {
  87   if (add)
  88     this->accepts_name_list_ = gh_cons (name, this->accepts_name_list_);
  89   else
  90     this->accepts_name_list_ = scm_delete_x (name, this->accepts_name_list_);
  91 }
  92
  93
  94 SCM
  95 Translator_def::modify_definition (SCM list, SCM str, bool add)
  96 {
  97   String s = ly_scm2string (str);
  98   if (!get_translator_l (s))
  99     error (_ ("Program has no such type"));
 100
 101   if (add)
 102     {
 103       if (scm_memq (str, list) != SCM_BOOL_F)
 104         {
 105           warning (_f ("Already contains: `%s'", s));
 106           warning (_f ("Not adding translator: `%s'", s));
 107         }
 108       else
 109         list= gh_cons (str, list);
 110     }
 111   else
 112     {
 113       list = scm_delete_x (str, list);
 114     }
 115   return list;
 116 }
 117
 118
 119
 120 void
 121 Translator_def::remove_element (SCM s)
 122 {
 123   this->end_consists_name_list_ = modify_definition (this->end_consists_name_list_, s, false);
 124   this->consists_name_list_ = modify_definition (this->consists_name_list_, s, false);
 125 }
 126
 127 void
 128 Translator_def::add_element (SCM s)
 129 {
 130   this->consists_name_list_ = modify_definition (this->consists_name_list_, s, true);
 131 }
 132
 133 void
 134 Translator_def::add_last_element (SCM s)
 135 {
 136   this->end_consists_name_list_ = modify_definition (this->end_consists_name_list_, s, true);
 137 }
 138 void
 139 Translator_def::add_push_property (SCM props, SCM syms,  SCM vals)
 140 {
 141   this->property_ops_ = gh_cons (gh_list (push_sym, props, syms, vals, SCM_UNDEFINED),
 142                                  this->property_ops_);
 143 }
 144
 145 void
 146 Translator_def::add_pop_property (SCM props, SCM syms)
 147 {
 148   this->property_ops_ = gh_cons (gh_list (push_sym, props, syms, SCM_UNDEFINED),
 149                                  this->property_ops_);
 150 }
 151
 152 /*
 153   Do it. SYMS maybe a symbol or a list of symbols. VAL is
 154   SCM_UNDEFINED in case of a pop
 155 */
 156 void
 157 Translator_def::apply_pushpop_property (Translator_group* me,SCM syms, SCM eprop, SCM val)
 158 {
 159   if (gh_symbol_p (syms))
 160     dynamic_cast<Translator_group*> (me)->execute_single_pushpop_property (syms, eprop, val);
 161   else for (SCM s = syms; gh_pair_p (s); s = gh_cdr (s))
 162     dynamic_cast<Translator_group*> (me)->execute_single_pushpop_property (gh_car (s), eprop, val);
 163 }
 164
 165
 166
 167 Link_array<Translator_def>
 168 Translator_def::path_to_acceptable_translator (SCM type_str, Music_output_def* odef) const
 169 {
 170   assert (gh_string_p (type_str));
 171
 172   Link_array<Translator_def> accepted_arr;
 173   for (SCM s = accepts_name_list_; gh_pair_p (s); s = gh_cdr (s))
 174     {
 175       Translator_def *t = unsmob_translator_def (odef->find_translator_l (gh_car (s)));
 176       if (!t)
 177         continue;
 178       accepted_arr.push (t);
 179     }
 180
 181   Link_array<Translator_def> best_result;
 182   for (int i=0; i < accepted_arr.size (); i++)
 183     {
 184       bool found =false;
 185       if (scm_equal_p (accepted_arr[i]->type_name_, type_str) == SCM_BOOL_T)
 186         found = true;
 187
 188       for (SCM s = accepted_arr[i]->type_aliases_; !found && gh_pair_p (s); s = gh_cdr (s))
 189         found = found ||  (gh_equal_p (gh_car (s), type_str));
 190
 191       if (found)
 192         {
 193           best_result.push (accepted_arr[i]);
 194           return best_result;
 195         }
 196     }
 197
 198   int best_depth= INT_MAX;
 199   for (int i=0; i < accepted_arr.size (); i++)
 200     {
 201       Translator_def * g = accepted_arr[i];
 202
 203       Link_array<Translator_def> result
 204         = g->path_to_acceptable_translator (type_str, odef);
 205       if (result.size () && result.size () < best_depth)
 206         {
 207           result.insert (g,0);
 208           best_result = result;
 209         }
 210     }
 211
 212   return best_result;
 213 }
 214 IMPLEMENT_UNSMOB (Translator_def,translator_def);
 215 IMPLEMENT_SMOBS (Translator_def);
 216 IMPLEMENT_DEFAULT_EQUAL_P (Translator_def);
 217
 218
 219 static SCM
 220 trans_list (SCM namelist, Translator_group*tg)
 221 {
 222   SCM l = SCM_EOL;
 223   for (SCM s = namelist; gh_pair_p (s) ; s = gh_cdr (s))
 224     {
 225       Translator * t = get_translator_l (ly_scm2string (gh_car (s)));
 226       if (!t)
 227         warning (_f ("can't find: `%s'", s));
 228       else
 229         {
 230           Translator * tr = t->clone ();
 231           SCM str = tr->self_scm ();
 232           l = gh_cons (str, l);
 233
 234           tr->daddy_trans_l_ = tg;
 235           tr->output_def_l_  = tg->output_def_l_;
 236
 237           scm_unprotect_object (str);
 238         }
 239     }
 240   return l;
 241 }
 242
 243
 244 Translator_group *
 245 Translator_def::instantiate (Music_output_def* md)
 246 {
 247   Translator * g = get_translator_l (ly_scm2string (translator_group_type_));
 248   g = g->clone ();
 249
 250   Translator_group *tg = dynamic_cast<Translator_group*> (g);
 251   tg->output_def_l_ = md;
 252   tg->definition_ = self_scm ();
 253   tg->type_str_ = ly_scm2string (type_name_);
 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 = gh_cdr (s))
 269     {
 270       SCM entry = gh_car (s);
 271       SCM type = gh_car (entry);
 272       entry = gh_cdr (entry);
 273
 274       if (type == push_sym)
 275         {
 276           SCM val = gh_cddr (entry);
 277           val = gh_pair_p (val) ? gh_car (val) : SCM_UNDEFINED;
 278
 279           apply_pushpop_property (tg, gh_car (entry), gh_cadr (entry), val);
 280         }
 281       else if (type == assign_sym)
 282         {
 283           tg->set_property (gh_car (entry), gh_cadr (entry));
 284         }
 285     }
 286 }
 287
 288 SCM
 289 Translator_def::clone_scm () const
 290 {
 291   Translator_def * t = new Translator_def (*this);
 292   return t->unprotected_smobify_self ();
 293 }
 294
 295 SCM
 296 Translator_def::make_scm ()
 297 {
 298   Translator_def* t = new Translator_def;
 299   return t->unprotected_smobify_self ();
 300 }
 301
 302 void
 303 Translator_def::add_property_assign (SCM nm, SCM val)
 304 {
 305   this->property_ops_ = gh_cons (gh_list (assign_sym, scm_string_to_symbol (nm), val, SCM_UNDEFINED),
 306                                  this->property_ops_);
 307 }
 308
 309 /*
 310   Default child context as a SCM string, or something else if there is
 311   none.
 312 */
 313 SCM
 314 Translator_def::default_child_context_name ()
 315 {
 316   SCM d = accepts_name_list_;
 317   return gh_pair_p (d) ? gh_car (scm_last_pair (d)) : SCM_EOL;
 318 }
 319
 320 SCM
 321 Translator_def::to_alist ()const
 322 {
 323   SCM l = SCM_EOL;
 324
 325   l = gh_cons (gh_cons (ly_symbol2scm ("consists"),  consists_name_list_), l);
 326   l = gh_cons (gh_cons (ly_symbol2scm ("end-consists"),  end_consists_name_list_), l);
 327   l = gh_cons (gh_cons (ly_symbol2scm ("accepts"),  accepts_name_list_), l);
 328   l = gh_cons (gh_cons (ly_symbol2scm ("property-ops"),  property_ops_), l);
 329   l = gh_cons (gh_cons (ly_symbol2scm ("type-name"),  type_name_), l); // junkme.
 330   l = gh_cons (gh_cons (ly_symbol2scm ("group-type"),  translator_group_type_), l);
 331
 332   return l;
 333 }