lily/translator-scheme.cc

   1 /*
   2   translator-scheme.cc --  implement Scheme context functions
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2002--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9
  10 #include "translator.hh"
  11 #include "context-def.hh"
  12
  13 #include "translator-group.hh"
  14 #include "lily-guile.hh"
  15
  16 LY_DEFINE(ly_get_context_property,
  17           "ly:get-context-property", 2, 0, 0,
  18           (SCM context, SCM name),
  19           "retrieve the value of @var{name} from context @var{context}")
  20 {
  21   Translator *t = unsmob_translator (context);
  22   Translator_group* tr=   dynamic_cast<Translator_group*> (t);
  23   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group");
  24   SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
  25
  26   return tr->internal_get_property (name);
  27
  28 }
  29
  30 LY_DEFINE(ly_set_context_property,
  31           "ly:set-context-property!", 3, 0, 0,
  32           (SCM context, SCM name, SCM val),
  33           "set value of property @var{name} in context @var{context} to @var{val}.")
  34 {
  35   Translator *t = unsmob_translator (context);
  36   Translator_group* tr=   dynamic_cast<Translator_group*> (t);
  37
  38   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
  39   SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
  40
  41   tr->internal_set_property (name, val);
  42
  43   return SCM_UNSPECIFIED;
  44 }
  45
  46
  47 LY_DEFINE(ly_context_property_where_defined,
  48           "ly:context-property-where-defined", 2, 0, 0,
  49           (SCM context, SCM name),
  50           "Return the context above @var{context} where @var{name}  is defined.")
  51 {
  52   Translator *t = unsmob_translator (context);
  53   Translator_group* tr = dynamic_cast<Translator_group*> (t);
  54   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
  55   SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
  56
  57
  58   tr = tr->where_defined (name);
  59
  60   if (tr)
  61     return tr->self_scm();
  62
  63   return SCM_EOL;
  64 }
  65
  66 LY_DEFINE(ly_unset_context_property,
  67           "ly:unset-context-property", 2, 0, 0,
  68           (SCM context, SCM name),
  69           "Unset value of property @var{name} in context @var{context}.")
  70 {
  71   Translator *t = unsmob_translator (context);
  72   Translator_group* tr = dynamic_cast<Translator_group*> (t);
  73   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
  74   SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
  75
  76   tr->unset_property (name);
  77
  78   return SCM_UNSPECIFIED;
  79 }
  80
  81
  82
  83 LY_DEFINE(ly_context_parent,
  84           "ly:context-parent", 1, 0, 0,
  85           (SCM context),
  86           "Return the parent of @var{context}, #f if none.")
  87 {
  88   Translator *t = unsmob_translator (context);
  89   Translator_group* tr=   dynamic_cast<Translator_group*> (t);
  90
  91   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
  92
  93   tr =  tr->daddy_trans_ ;
  94   if (tr)
  95     return tr->self_scm();
  96   else
  97     return SCM_BOOL_F;
  98 }
  99
 100 /*
 101   Todo: should support translator IDs, and creation?
 102  */
 103 LY_DEFINE(ly_translator_find,
 104           "ly:translator-find", 2, 0,0,
 105           (SCM context, SCM name),
 106           "Find a parent of @var{context} that has name or alias @var{name}. "
 107           "Return @code{#f} if not found." )
 108 {
 109   Translator_group* tr=   dynamic_cast<Translator_group*> ( unsmob_translator (context));
 110
 111   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "context");
 112   SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
 113
 114   while (tr)
 115     {
 116       if (tr->is_alias (name))
 117         return tr->self_scm();
 118       tr =  tr->daddy_trans_ ;
 119     }
 120
 121   return SCM_BOOL_F;
 122 }
 123
 124
 125 LY_DEFINE(ly_context_properties,
 126           "ly:context-properties", 1, 0, 0,
 127           (SCM context),
 128           "Return all properties  of @var{context} in an alist.")
 129 {
 130   Translator *t = unsmob_translator (context);
 131   Translator_group* tr=   dynamic_cast<Translator_group*> (t);
 132
 133   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
 134
 135   return tr->properties_as_alist ();
 136 }
 137
 138
 139
 140 LY_DEFINE(ly_translator_name,
 141           "ly:translator-name", 1,0,0,  (SCM trans),
 142           "Return the type name of the translator object @var{trans}. The name is a symbol.")
 143 {
 144   Translator * tr =  unsmob_translator (trans);
 145   SCM_ASSERT_TYPE(tr, trans, SCM_ARG1, __FUNCTION__, "Translator");
 146
 147   char const* nm = classname (tr);
 148   return ly_symbol2scm (nm);
 149 }
 150
 151
 152 LY_DEFINE(ly_context_id,
 153           "ly:context-id", 1,0,0,  (SCM context),
 154           "Return the id string of @var{context}, i.e. for @code{\\context Voice "
 155 "= one .. } it will return the string @code{one}.")
 156 {
 157   Translator_group* tr =  dynamic_cast<Translator_group*> (unsmob_translator (context));
 158   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
 159
 160   return scm_makfrom0str (tr->id_string_. to_str0 ());
 161 }
 162
 163
 164 LY_DEFINE(ly_context_name,
 165           "ly:context-name", 1,0,0,  (SCM context),
 166           "Return the name of @var{context}, i.e. for @code{\\context Voice "
 167 "= one .. } it will return the symbol @code{Voice}.")
 168 {
 169   Translator_group* tr =  dynamic_cast<Translator_group*> (unsmob_translator (context));
 170   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
 171
 172   return unsmob_context_def (tr->definition_)->get_context_name ();
 173 }
 174
 175
 176 LY_DEFINE(ly_translator_description,
 177           "ly:translator-description",
 178           1,0,0, (SCM me),
 179           "Return an alist of properties of  translator @var{me}.")
 180 {
 181   Translator *tr =unsmob_translator (me);
 182   SCM_ASSERT_TYPE (tr, me, SCM_ARG1, __FUNCTION__, "Context");
 183
 184   return tr->translator_description ();
 185 }
 186
 187
 188 LY_DEFINE(ly_context_pushpop_property,
 189           "ly:context-pushpop-property", 3, 1, 0,
 190           (SCM context, SCM grob, SCM eltprop, SCM val),
 191           "Do a single @code{\\override} or @code{\\revert} operation "
 192           "in @var{context}. The grob definition @code{grob} is extended with "
 193           "@code{eltprop} (if @var{val} is specified) "
 194           "or reverted (if  unspecified).")
 195 {
 196   Translator_group *tg = dynamic_cast<Translator_group*> (unsmob_translator (context));
 197
 198   SCM_ASSERT_TYPE(tg, context, SCM_ARG1, __FUNCTION__, "context");
 199   SCM_ASSERT_TYPE(gh_symbol_p (grob), grob, SCM_ARG2, __FUNCTION__, "symbol");
 200   SCM_ASSERT_TYPE(gh_symbol_p (eltprop), eltprop, SCM_ARG3, __FUNCTION__, "symbol");
 201
 202   execute_pushpop_property (tg, grob, eltprop, val);
 203
 204   return SCM_UNDEFINED;
 205 }
 206
 207 LY_DEFINE(ly_context_p,
 208           "ly:context?", 1, 0, 0,
 209           (SCM x),
 210           "Type predicate: is @var{x} a context?")
 211 {
 212   Translator_group *tg = dynamic_cast<Translator_group*> (unsmob_translator (x));
 213
 214   return SCM_BOOL (tg);
 215 }
 216
 217
 218 int
 219 Translator::print_smob (SCM s, SCM port, scm_print_state *)
 220 {
 221   Translator *sc = (Translator *) ly_cdr (s);
 222
 223   scm_puts ("#<Translator ", port);
 224   if (Context_def *d=unsmob_context_def (sc->definition_))
 225     {
 226       scm_display (d->get_context_name (), port);
 227     }
 228   else
 229     scm_display (ly_translator_name (s), port);
 230
 231   if (Translator_group *td=dynamic_cast<Translator_group*> (sc))
 232     {
 233       scm_puts ("=", port);
 234       scm_puts (td->id_string_.to_str0 (), port);
 235     }
 236
 237   scm_display (sc->simple_trans_list_, port);
 238
 239   /*
 240     don't try to print properties, that is too much hassle.
 241    */
 242   scm_puts (" >", port);
 243
 244   return 1;
 245 }
 246