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 Translator_def::~Translator_def ()
  60 {
  61 }
  62
  63 Translator_def::Translator_def (Translator_def const & s)
  64   : Input (s)
  65 {
  66   type_aliases_ = SCM_EOL;
  67   translator_group_type_ = SCM_EOL;
  68   accepts_name_list_ = SCM_EOL;
  69   consists_name_list_ = SCM_EOL;
  70   end_consists_name_list_ = SCM_EOL;
  71   property_ops_ = SCM_EOL;
  72   type_name_ = SCM_EOL;
  73   description_ = SCM_EOL;
  74
  75   smobify_self();
  76   description_ = s.description_;
  77
  78   consists_name_list_ = scm_list_copy (s.consists_name_list_);
  79   end_consists_name_list_ = scm_list_copy (s.end_consists_name_list_);
  80   accepts_name_list_ = scm_list_copy (s.accepts_name_list_);
  81   property_ops_ = scm_list_copy (s.property_ops_);
  82   type_aliases_ = scm_list_copy (s.type_aliases_);
  83   translator_group_type_ = s.translator_group_type_;
  84   type_name_ = s.type_name_;
  85 }
  86
  87
  88
  89 void
  90 Translator_def::set_acceptor (SCM name, bool add)
  91 {
  92   assert (gh_symbol_p (name));
  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
 145 void
 146 Translator_def::add_property_operation (SCM what)
 147 {
 148   this->property_ops_ = gh_cons (what, this->property_ops_);
 149 }
 150
 151
 152
 153 Link_array<Translator_def>
 154 Translator_def::path_to_acceptable_translator (SCM type_sym, Music_output_def* odef) const
 155 {
 156   assert (gh_symbol_p (type_sym));
 157
 158   Link_array<Translator_def> accepteds;
 159   for (SCM s = accepts_name_list_; gh_pair_p (s); s = ly_cdr (s))
 160     {
 161       Translator_def *t = unsmob_translator_def (odef->find_translator (ly_car (s)));
 162       if (!t)
 163         continue;
 164       accepteds.push (t);
 165     }
 166
 167   Link_array<Translator_def> best_result;
 168   for (int i=0; i < accepteds.size (); i++)
 169     {
 170       /*
 171         don't check aliases, because \context Staff should not create RhythmicStaff.
 172       */
 173       if (gh_equal_p (accepteds[i]->type_name_, type_sym))
 174         {
 175           best_result.push (accepteds[i]);
 176           return best_result;
 177         }
 178     }
 179
 180   int best_depth= INT_MAX;
 181   for (int i=0; i < accepteds.size (); i++)
 182     {
 183       Translator_def * g = accepteds[i];
 184
 185       Link_array<Translator_def> result
 186         = g->path_to_acceptable_translator (type_sym, odef);
 187       if (result.size () && result.size () < best_depth)
 188         {
 189           result.insert (g,0);
 190           best_result = result;
 191
 192           /*
 193             this following line was added in 1.9.3, but hsould've been
 194             there all along... Let's hope it doesn't cause nightmares.
 195            */
 196           best_depth = result.size();
 197         }
 198     }
 199
 200   return best_result;
 201 }
 202
 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 = ly_cdr (s))
 212     {
 213       Translator * t = get_translator (ly_scm2string (ly_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_ = tg;
 223           tr->output_def_  = tg->output_def_;
 224
 225           scm_gc_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 (ly_scm2string (translator_group_type_));
 236   g = g->clone ();
 237
 238   Translator_group *tg = dynamic_cast<Translator_group*> (g);
 239   tg->output_def_ = md;
 240   tg->definition_ = self_scm ();
 241
 242   /*
 243     TODO: ugh. we're reversing CONSISTS_NAME_LIST_ here
 244    */
 245   SCM l1 = trans_list (consists_name_list_, tg);
 246   SCM l2 =trans_list (end_consists_name_list_,tg);
 247   l1 = scm_reverse_x (l1, l2);
 248
 249   tg->simple_trans_list_ = l1;
 250
 251   return tg;
 252 }
 253
 254 void
 255 Translator_def::apply_default_property_operations (Translator_group*tg)
 256 {
 257   apply_property_operations (tg, property_ops_);
 258 }
 259
 260
 261 SCM
 262 Translator_def::clone_scm () const
 263 {
 264   Translator_def * t = new Translator_def (*this);
 265   scm_gc_unprotect_object (t->self_scm());
 266   return t->self_scm();
 267 }
 268
 269 SCM
 270 Translator_def::make_scm ()
 271 {
 272   Translator_def* t = new Translator_def;
 273   scm_gc_unprotect_object (t->self_scm());
 274   return t->self_scm();
 275 }
 276
 277
 278 /*
 279   Default child context as a SCM string, or something else if there is
 280   none.
 281 */
 282 SCM
 283 Translator_def::default_child_context_name ()
 284 {
 285   SCM d = accepts_name_list_;
 286   return gh_pair_p (d) ? ly_car (scm_last_pair (d)) : SCM_EOL;
 287 }
 288
 289 SCM
 290 Translator_def::to_alist () const
 291 {
 292   SCM l = SCM_EOL;
 293
 294   l = gh_cons (gh_cons (ly_symbol2scm ("consists"),  consists_name_list_), l);
 295   l = gh_cons (gh_cons (ly_symbol2scm ("description"),  description_), l);
 296   l = gh_cons (gh_cons (ly_symbol2scm ("aliases"),  type_aliases_), l);
 297   l = gh_cons (gh_cons (ly_symbol2scm ("end-consists"),
 298                         end_consists_name_list_), l);
 299   l = gh_cons (gh_cons (ly_symbol2scm ("accepts"),  accepts_name_list_), l);
 300   l = gh_cons (gh_cons (ly_symbol2scm ("property-ops"),  property_ops_), l);
 301
 302   /*
 303     junkme:
 304    */
 305   l = gh_cons (gh_cons (ly_symbol2scm ("type-name"),  type_name_), l);
 306
 307   l = gh_cons (gh_cons (ly_symbol2scm ("group-type"),  translator_group_type_), l);
 308
 309   return l;
 310 }