2003 -> 2004

[lilypond.git] / lily / translator-scheme.cc

diff --git a/lily/translator-scheme.cc b/lily/translator-scheme.cc
index 2ced54dbf190604829883a751fc5c7bbbc32b78c..750c3617edacafe6a8910621edc62441e7c50d1a 100644 (file)
--- a/lily/translator-scheme.cc
+++ b/lily/translator-scheme.cc
@@ -1,14 +1,14 @@
 /*   
-translator-scheme.cc --  implement 
+  translator-scheme.cc --  implement Scheme context functions
+ 
+  source file of the GNU LilyPond music typesetter
 
-source file of the GNU LilyPond music typesetter
-
-(c) 2002--2003 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+  (c) 2002--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
  */
 
 #include "translator.hh"
-#include "translator-def.hh"
+#include "context-def.hh"
 
 #include "translator-group.hh"
 #include "lily-guile.hh"
@@ -28,7 +28,7 @@ LY_DEFINE(ly_get_context_property,
 }
 
 LY_DEFINE(ly_set_context_property,
-         "ly:set-context-property", 3, 0, 0,
+         "ly:set-context-property!", 3, 0, 0,
          (SCM context, SCM name, SCM val),
          "set value of property @var{name} in context @var{context} to @var{val}.")
 {
@@ -54,7 +54,13 @@ LY_DEFINE(ly_context_property_where_defined,
   SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
   SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
 
-  return tr->where_defined (name)->self_scm();
+
+  tr = tr->where_defined (name);
+
+  if (tr)
+    return tr->self_scm();
+
+  return SCM_EOL;
 }
 
 LY_DEFINE(ly_unset_context_property,
@@ -91,6 +97,29 @@ LY_DEFINE(ly_context_parent,
     return SCM_BOOL_F;
 }
 
+/*
+  Todo: should support translator IDs, and creation?
+ */
+LY_DEFINE(ly_translator_find,
+         "ly:translator-find", 2, 0,0,
+         (SCM context, SCM name),
+         "Find a parent of @var{context} that has name or alias @var{name}. "
+         "Return @code{#f} if not found." )
+{
+  Translator_group* tr=   dynamic_cast<Translator_group*> ( unsmob_translator (context));
+
+  SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "context");
+  SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
+  
+  while (tr)
+    {
+      if (tr->is_alias (name))
+       return tr->self_scm();
+      tr =  tr->daddy_trans_ ;
+    }
+  
+  return SCM_BOOL_F;
+}
 
 
 LY_DEFINE(ly_context_properties,
@@ -110,15 +139,40 @@ LY_DEFINE(ly_context_properties,
 
 LY_DEFINE(ly_translator_name,
          "ly:translator-name", 1,0,0,  (SCM trans),
-         "Return the type name of the translator @var{trans}.")
+         "Return the type name of the translator object @var{trans}. The name is a symbol.")
 {
-  Translator* tr =  unsmob_translator (trans);
-  SCM_ASSERT_TYPE(tr, trans, SCM_ARG1, __FUNCTION__, "Context");
+  Translator * tr =  unsmob_translator (trans);
+  SCM_ASSERT_TYPE(tr, trans, SCM_ARG1, __FUNCTION__, "Translator");
 
   char const* nm = classname (tr);
-  return scm_makfrom0str (nm);
+  return ly_symbol2scm (nm);
+}
+
+
+LY_DEFINE(ly_context_id,
+         "ly:context-id", 1,0,0,  (SCM context),
+         "Return the id string of @var{context}, i.e. for @code{\\context Voice "
+"= one .. } it will return the string @code{one}.")
+{
+  Translator_group* tr =  dynamic_cast<Translator_group*> (unsmob_translator (context));
+  SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
+
+  return scm_makfrom0str (tr->id_string_. to_str0 ());
 }
 
+
+LY_DEFINE(ly_context_name,
+         "ly:context-name", 1,0,0,  (SCM context),
+         "Return the name of @var{context}, i.e. for @code{\\context Voice "
+"= one .. } it will return the symbol @code{Voice}.")
+{
+  Translator_group* tr =  dynamic_cast<Translator_group*> (unsmob_translator (context));
+  SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
+
+  return unsmob_context_def (tr->definition_)->get_context_name (); 
+}
+
+
 LY_DEFINE(ly_translator_description,
          "ly:translator-description",
          1,0,0, (SCM me),
@@ -131,19 +185,55 @@ LY_DEFINE(ly_translator_description,
 }
 
 
+LY_DEFINE(ly_context_pushpop_property,
+         "ly:context-pushpop-property", 3, 1, 0,
+         (SCM context, SCM grob, SCM eltprop, SCM val),
+         "Do a single @code{\\override} or @code{\\revert} operation "
+         "in @var{context}. The grob definition @code{grob} is extended with "
+         "@code{eltprop} (if @var{val} is specified) "
+         "or reverted (if  unspecified).")
+{
+  Translator_group *tg = dynamic_cast<Translator_group*> (unsmob_translator (context));
+
+  SCM_ASSERT_TYPE(tg, context, SCM_ARG1, __FUNCTION__, "context");
+  SCM_ASSERT_TYPE(gh_symbol_p (grob), grob, SCM_ARG2, __FUNCTION__, "symbol");
+  SCM_ASSERT_TYPE(gh_symbol_p (eltprop), eltprop, SCM_ARG3, __FUNCTION__, "symbol");
+
+  tg->execute_pushpop_property (grob, eltprop, val);
+
+  return SCM_UNDEFINED;
+}
+
+LY_DEFINE(ly_context_p,
+         "ly:context?", 1, 0, 0,
+         (SCM x),
+         "Type predicate: is @var{x} a context?")
+{
+  Translator_group *tg = dynamic_cast<Translator_group*> (unsmob_translator (x));
+
+  return SCM_BOOL (tg);
+}
+         
+
 int
 Translator::print_smob (SCM s, SCM port, scm_print_state *)
 {
   Translator *sc = (Translator *) ly_cdr (s);
      
   scm_puts ("#<Translator ", port);
-  if (Translator_def *d=unsmob_translator_def (sc->definition_))
+  if (Context_def *d=unsmob_context_def (sc->definition_))
     {
-      scm_display (d->type_name_, port);
+      scm_display (d->get_context_name (), port);
     }
   else
     scm_display (ly_translator_name (s), port);
 
+  if (Translator_group *td=dynamic_cast<Translator_group*> (sc))
+    {
+      scm_puts ("=", port);
+      scm_puts (td->id_string_.to_str0 (), port);
+    }
+  
   scm_display (sc->simple_trans_list_, port);
 
   /*
@@ -153,3 +243,4 @@ Translator::print_smob (SCM s, SCM port, scm_print_state *)
   
   return 1;
 }
+