patch::: 1.3.96.jcn9

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

diff --git a/lily/translator-group.cc b/lily/translator-group.cc
index 19b54bb2aab51f4525d78951cde98d455e70ce45..6b735ad953232e7c317320ae2bd279c9013c6855 100644 (file)
--- a/lily/translator-group.cc
+++ b/lily/translator-group.cc
@@ -33,7 +33,8 @@ Translator_group::properties_dict () const
 
 Translator_group::~Translator_group ()
 {
-  assert (removable_b());
+  
+  //assert (removable_b());
 }
 
 
@@ -271,12 +272,7 @@ Translator_group::each (Method_pointer method)
   static_each (trans_group_list_, method);
 }
 
-void
-Translator_group::do_print() const
-{
-#ifndef NPRINT
-#endif
-}
+
 
 void
 Translator_group::do_add_processing ()
@@ -306,15 +302,14 @@ Translator_group::where_defined (SCM sym) const
 SCM
 Translator_group::get_property (SCM sym) const
 {
-  if (properties_dict ()->elem_b (sym))
-    {
-      return properties_dict ()->get (sym);
-    }
+  SCM val =SCM_UNDEFINED;
+  if (properties_dict ()->try_retrieve (sym, &val))
+    return val;
 
   if (daddy_trans_l_)
     return daddy_trans_l_->get_property (sym);
   
-  return SCM_UNDEFINED;
+  return val;
 }
 
 void
@@ -342,8 +337,57 @@ Translator_group::execute_single_pushpop_property (SCM prop, SCM eltprop, SCM va
        {
          SCM prev = get_property (prop);
 
-         prev = gh_cons (gh_cons (eltprop, val), prev);
-         set_property (prop, prev);
+         /*
+           we don't tack onto SCM_UNDEFINED, because it creates
+           errors down the line, if we do scm_assoc().
+          */
+         if (gh_pair_p (prev) || prev == SCM_EOL)
+           {
+             bool ok = true;
+             
+             SCM errport = scm_current_error_port ();
+             
+             SCM meta = scm_assoc (ly_symbol2scm ("meta"), prev);
+             SCM props = scm_assoc (ly_symbol2scm ("properties"), gh_cdr (meta));
+             SCM propdesc = scm_assoc (eltprop, gh_cdr (props));
+             if (!gh_pair_p (propdesc))
+               {
+                 scm_puts (_("Couldn't find property description for #'").ch_C(),errport);
+                 scm_display (eltprop, errport);
+
+                 scm_puts (_(" in element description ").ch_C(),errport);
+                 scm_display (prop, errport);
+
+                 scm_puts (_(". Perhaps you made a typing error?\n").ch_C(),errport);            
+               }
+             else
+               {
+                 
+                 SCM predicate = gh_cadr (propdesc);
+                 if (gh_call1 (predicate, val) == SCM_BOOL_F)
+                   {
+                     ok = false;
+                     scm_puts (_("Failed typecheck for #'").ch_C (),errport);
+                     scm_display (eltprop,errport);
+                     scm_puts ( _(", value ").ch_C (), errport);
+                     scm_display (val, errport);
+                     scm_puts (_(" must satisfy ").ch_C (), errport);
+                     scm_display (predicate, errport);
+                     scm_puts ("\n", errport);               
+                   }
+               }
+
+             if (ok)
+               {
+                 prev = gh_cons (gh_cons (eltprop, val), prev);
+                 set_property (prop, prev);
+               }
+           }
+         else
+           {
+             // warning here.
+           }
+         
        }
       else
        {