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