Doc: Usage 1.2 - Added note about using wildcards

[lilypond.git] / lily / grob-property.cc

diff --git a/lily/grob-property.cc b/lily/grob-property.cc
index 2a4368f9ab7ffa5b25c9f5fe01278c0e1f83abfa..779f0e91cbcb4712deb96e765e5f4db4f8c4c506 100644 (file)
--- a/lily/grob-property.cc
+++ b/lily/grob-property.cc
@@ -18,6 +18,7 @@
 #include "program-option.hh"
 #include "profile.hh"
 #include "simple-closure.hh"
+#include "unpure-pure-container.hh"
 #include "warn.hh"
 #include "protected-scm.hh"
 
@@ -35,8 +36,8 @@ print_property_callback_stack ()
 }
 #endif
 
-static SCM modification_callback = SCM_EOL;
-static SCM cache_callback = SCM_EOL;
+static Protected_scm modification_callback = SCM_EOL;
+static Protected_scm cache_callback = SCM_EOL;
 
 /*
 FIXME: this should use ly:set-option interface instead.
@@ -122,7 +123,8 @@ Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v)
   if (do_internal_type_checking_global)
     {
       if (!ly_is_procedure (v)
-          && !is_simple_closure (v)
+          && !Simple_closure::is_smob (v)
+          && !Unpure_pure_container::is_smob (v)
           && v != ly_symbol2scm ("calculation-in-progress"))
         type_check_assignment (sym, v, ly_symbol2scm ("backend-type?"));
 
@@ -149,7 +151,8 @@ Grob::internal_get_property_data (SCM sym) const
   if (do_internal_type_checking_global && scm_is_pair (handle))
     {
       SCM val = scm_cdr (handle);
-      if (!ly_is_procedure (val) && !is_simple_closure (val))
+      if (!ly_is_procedure (val) && !Simple_closure::is_smob (val)
+          && !Unpure_pure_container::is_smob (val))
         type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"));
 
       check_interfaces_for_property (this, sym);
@@ -166,9 +169,9 @@ Grob::internal_get_property (SCM sym) const
 #ifndef NDEBUG
   if (val == ly_symbol2scm ("calculation-in-progress"))
     {
-      programming_error (_f ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
-                             ly_symbol2string (sym).c_str (),
-                             name ().c_str ()));
+      programming_error (to_string ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
+                                    ly_symbol2string (sym).c_str (),
+                                    name ().c_str ()));//assert (1==0);
       if (debug_property_callbacks)
         {
           message ("backtrace: ");
@@ -177,8 +180,11 @@ Grob::internal_get_property (SCM sym) const
     }
 #endif
 
+  if (Unpure_pure_container *upc = Unpure_pure_container::unsmob (val))
+    val = upc->unpure_part ();
+
   if (ly_is_procedure (val)
-      || is_simple_closure (val))
+      || Simple_closure::is_smob (val))
     {
       Grob *me = ((Grob *)this);
       val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val);
@@ -194,9 +200,18 @@ Grob::internal_get_pure_property (SCM sym, int start, int end) const
   SCM val = internal_get_property_data (sym);
   if (ly_is_procedure (val))
     return call_pure_function (val, scm_list_1 (self_scm ()), start, end);
-  if (is_simple_closure (val))
+
+  if (Unpure_pure_container *upc = Unpure_pure_container::unsmob (val)) {
+    // Do cache, if the function ignores 'start' and 'end'
+    if (upc->is_unchanging ())
+      return internal_get_property (sym);
+    else
+      return call_pure_function (val, scm_list_1 (self_scm ()), start, end);
+  }
+
+  if (Simple_closure *sc = Simple_closure::unsmob (val))
     return evaluate_with_simple_closure (self_scm (),
-                                         simple_closure_expression (val),
+                                         sc->expression (),
                                          true, start, end);
   return val;
 }
@@ -225,10 +240,10 @@ Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
   SCM value = SCM_EOL;
   if (ly_is_procedure (proc))
     value = scm_call_1 (proc, self_scm ());
-  else if (is_simple_closure (proc))
+  else if (Simple_closure *sc = Simple_closure::unsmob (proc))
     {
       value = evaluate_with_simple_closure (self_scm (),
-                                            simple_closure_expression (proc),
+                                            sc->expression (),
                                             false, 0, 0);
     }
 
@@ -237,17 +252,12 @@ Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
     grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
 #endif
 
-  /*
-    If the function returns SCM_UNSPECIFIED, we assume the
-    property has been set with an explicit set_property ()
-    call.
-  */
   if (value == SCM_UNSPECIFIED)
     {
       value = get_property_data (sym);
       assert (value == SCM_EOL || value == marker);
       if (value == marker)
-        *alist = scm_assq_remove_x (*alist, marker);
+        *alist = scm_assq_remove_x (*alist, sym);
     }
   else
     {
@@ -294,7 +304,8 @@ Grob::internal_get_object (SCM sym) const
     {
       SCM val = scm_cdr (s);
       if (ly_is_procedure (val)
-          || is_simple_closure (val))
+          || Simple_closure::is_smob (val)
+          || Unpure_pure_container::is_smob (val))
         {
           Grob *me = ((Grob *)this);
           val = me->try_callback_on_alist (&me->object_alist_, sym, val);
@@ -321,9 +332,35 @@ Grob::internal_has_interface (SCM k)
 SCM
 call_pure_function (SCM unpure, SCM args, int start, int end)
 {
-  SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function");
+  if (Unpure_pure_container *upc = Unpure_pure_container::unsmob (unpure))
+    {
+      SCM pure = upc->pure_part ();
+
+      if (Simple_closure *sc = Simple_closure::unsmob (pure))
+        {
+          SCM expr = sc->expression ();
+          return evaluate_with_simple_closure (scm_car (args), expr, true, start, end);
+        }
+
+      if (ly_is_procedure (pure))
+        return scm_apply_0 (pure,
+                            scm_append (scm_list_2 (scm_list_3 (scm_car (args),
+                                                                scm_from_int (start),
+                                                                scm_from_int (end)),
+                                                    scm_cdr (args))));
+
+      return pure;
+    }
+
+  if (Simple_closure *sc = Simple_closure::unsmob (unpure))
+    {
+      SCM expr = sc->expression ();
+      return evaluate_with_simple_closure (scm_car (args), expr, true, start, end);
+    }
+
+  if (!ly_is_procedure (unpure))
+    return unpure;
 
-  return scm_apply_0 (scm_call_pure_function,
-                      scm_list_4 (unpure, args, scm_from_int (start), scm_from_int (end)));
+  return SCM_BOOL_F;
 }