lily/translator-scheme.cc

   1 /*
   2 translator-scheme.cc --  implement
   3
   4 source file of the GNU LilyPond music typesetter
   5
   6 (c) 2002--2003 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9
  10 #include "translator.hh"
  11 #include "translator-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   if (tr)
  60     return tr?  tr->self_scm():  SCM_EOL;
  61 }
  62
  63 LY_DEFINE(ly_unset_context_property,
  64           "ly:unset-context-property", 2, 0, 0,
  65           (SCM context, SCM name),
  66           "Unset value of property @var{name} in context @var{context}.")
  67 {
  68   Translator *t = unsmob_translator (context);
  69   Translator_group* tr = dynamic_cast<Translator_group*> (t);
  70   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
  71   SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
  72
  73   tr->unset_property (name);
  74
  75   return SCM_UNSPECIFIED;
  76 }
  77
  78
  79
  80 LY_DEFINE(ly_context_parent,
  81           "ly:context-parent", 1, 0, 0,
  82           (SCM context),
  83           "Return the parent of @var{context}, #f if none.")
  84 {
  85   Translator *t = unsmob_translator (context);
  86   Translator_group* tr=   dynamic_cast<Translator_group*> (t);
  87
  88   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
  89
  90   tr =  tr->daddy_trans_ ;
  91   if (tr)
  92     return tr->self_scm();
  93   else
  94     return SCM_BOOL_F;
  95 }
  96
  97
  98
  99 LY_DEFINE(ly_context_properties,
 100           "ly:context-properties", 1, 0, 0,
 101           (SCM context),
 102           "Return all properties  of @var{context} in an alist.")
 103 {
 104   Translator *t = unsmob_translator (context);
 105   Translator_group* tr=   dynamic_cast<Translator_group*> (t);
 106
 107   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
 108
 109   return tr->properties_as_alist ();
 110 }
 111
 112
 113
 114 LY_DEFINE(ly_translator_name,
 115           "ly:translator-name", 1,0,0,  (SCM trans),
 116           "Return the type name of the translator @var{trans}.")
 117 {
 118   Translator* tr =  unsmob_translator (trans);
 119   SCM_ASSERT_TYPE(tr, trans, SCM_ARG1, __FUNCTION__, "Context");
 120
 121   char const* nm = classname (tr);
 122   return scm_makfrom0str (nm);
 123 }
 124
 125 LY_DEFINE(ly_translator_description,
 126           "ly:translator-description",
 127           1,0,0, (SCM me),
 128           "Return an alist of properties of  translator @var{me}.")
 129 {
 130   Translator *tr =unsmob_translator (me);
 131   SCM_ASSERT_TYPE (tr, me, SCM_ARG1, __FUNCTION__, "Context");
 132
 133   return tr->translator_description ();
 134 }
 135
 136
 137 int
 138 Translator::print_smob (SCM s, SCM port, scm_print_state *)
 139 {
 140   Translator *sc = (Translator *) ly_cdr (s);
 141
 142   scm_puts ("#<Translator ", port);
 143   if (Translator_def *d=unsmob_translator_def (sc->definition_))
 144     {
 145       scm_display (d->type_name_, port);
 146     }
 147   else
 148     scm_display (ly_translator_name (s), port);
 149
 150   scm_display (sc->simple_trans_list_, port);
 151
 152   /*
 153     don't try to print properties, that is too much hassle.
 154    */
 155   scm_puts (" >", port);
 156
 157   return 1;
 158 }