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