X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext-property.cc;h=5234d1113fccc00ccd1b9421697609bb72ea5f13;hb=10af86c3285db93cf559c3796f9deba981d0f27b;hp=bc7016babb89df2927b1ae088ee1702a52c9870a;hpb=00e3e15364b9d3c94cda1bcab9f889bb95f6832d;p=lilypond.git

diff --git a/lily/context-property.cc b/lily/context-property.cc
index bc7016babb..5234d1113f 100644
--- a/lily/context-property.cc
+++ b/lily/context-property.cc
@@ -16,52 +16,6 @@
 #include "spanner.hh"
 #include "warn.hh"
 
-SCM
-lookup_nested_property (SCM alist,
-			SCM grob_property_path)
-{
-  if (scm_is_pair (grob_property_path))
-    {
-      SCM sym = scm_car (grob_property_path);
-      SCM handle = scm_assq (sym, alist);
-
-      if (handle == SCM_BOOL_F)
-	return SCM_EOL;
-      else
-	return lookup_nested_property (scm_cdr (handle),
-				       scm_cdr (grob_property_path));
-    }
-  else 
-    return alist;
-}
-
-/*
-  copy ALIST leaving out SYMBOL. Copying stops at ALIST_END
-*/
-SCM
-evict_from_alist (SCM symbol,
-		  SCM alist,
-		  SCM alist_end)
-{
-  SCM new_alist = SCM_EOL;
-  SCM *tail = &new_alist;
-
-  while (alist != alist_end)
-    {
-      if (ly_is_equal (scm_caar (alist), symbol))
-	{
-	  alist = scm_cdr (alist);
-	  break;
-	}
-
-      *tail = scm_cons (scm_car (alist), SCM_EOL);
-      tail = SCM_CDRLOC (*tail);
-      alist = scm_cdr (alist);
-    }
-
-  *tail = alist;
-  return new_alist;
-}
 
 void
 general_pushpop_property (Context *context,
@@ -95,75 +49,105 @@ general_pushpop_property (Context *context,
   indicates nested alists, eg. '(beamed-stem-lengths details)
   
 */
+
+
 void
-execute_general_pushpop_property (Context *context,
-				  SCM context_property,
-				  SCM grob_property_path,
-				  SCM new_value
-				  )
+execute_override_property (Context *context,
+			   SCM context_property,
+			   SCM grob_property_path,
+			   SCM new_value)
 {
   SCM current_context_val = SCM_EOL;
-  if (new_value != SCM_UNDEFINED)
-    {
-      Context *where = context->where_defined (context_property, &current_context_val);
+  
+  Context *where = context->where_defined (context_property,
+					   &current_context_val);
 
-      /*
-	Don't mess with MIDI.
-      */
-      if (!where)
-	return;
+  /*
+    Don't mess with MIDI.
+  */
+  if (!where)
+    return;
 
-      if (where != context)
-	{
-	  SCM base = updated_grob_properties (context, context_property);
-	  current_context_val = scm_cons (base, base);
-	  context->set_property (context_property, current_context_val);
-	}
+  if (where != context)
+    {
+      SCM base = updated_grob_properties (context, context_property);
+      current_context_val = scm_cons (base, base);
+      context->set_property (context_property, current_context_val);
+    }
 
-      if (!scm_is_pair (current_context_val))
-	{
-	  programming_error ("Grob definition should be cons");
-	  return;
-	}
+  if (!scm_is_pair (current_context_val))
+    {
+      programming_error ("Grob definition should be cons");
+      return;
+    }
 
-      SCM prev_alist = scm_car (current_context_val);
-      SCM symbol = scm_car (grob_property_path);
-      SCM target_alist
-	= lookup_nested_property (prev_alist,
-				  scm_reverse (scm_cdr (grob_property_path)));
+  SCM target_alist = scm_car (current_context_val);
 
-      target_alist = scm_acons (symbol, new_value, target_alist);
+  SCM symbol = scm_car (grob_property_path);
+  if (scm_is_pair (scm_cdr (grob_property_path)))
+    {
+      new_value = nested_property_alist (ly_assoc_get (symbol, target_alist, 
+						       SCM_EOL),
+					 scm_cdr (grob_property_path),
+					 new_value);
+    }
 
-      bool ok = true;
-      if (!scm_is_pair (scm_cdr (grob_property_path)))
-	{
-	  if (!ly_is_procedure (new_value)
-	      && !is_simple_closure (new_value))
-	    ok = type_check_assignment (symbol, new_value,
-					ly_symbol2scm ("backend-type?"));
-
-	  /*
-	    tack onto alist.  We can use set_car, since
-	    updated_grob_properties () in child contexts will check
-	    for changes in the car.
-	  */
-	  if (ok)
-	    {
-	      scm_set_car_x (current_context_val, target_alist);
-	    }
-	}
-      else
-	{
-	  execute_general_pushpop_property (context,
-					    context_property,
-					    scm_cdr (grob_property_path),
-					    target_alist
-					    );
-	}
+  // it's tempting to replace the head of the list if it's the same
+  // property. However, we have to keep this info around, in case we have to
+  // \revert back to it.
+  
+  target_alist = scm_acons (symbol, new_value, target_alist);
+
+  bool ok = true;
+  if (!ly_is_procedure (new_value)
+      && !is_simple_closure (new_value))
+    ok = type_check_assignment (symbol, new_value,
+				ly_symbol2scm ("backend-type?"));
+
+  /*
+    tack onto alist.  We can use set_car, since
+    updated_grob_properties () in child contexts will check
+    for changes in the car.
+  */
+  if (ok)
+    {
+      scm_set_car_x (current_context_val, target_alist);
     }
-  else if (context->where_defined (context_property, &current_context_val) == context)
+}
+
+void
+execute_revert_property (Context *context,
+			 SCM context_property,
+			 SCM grob_property_path);
+
+void
+execute_general_pushpop_property (Context *context,
+				  SCM context_property,
+				  SCM grob_property_path,
+				  SCM new_value
+				  )
+{
+  if (new_value != SCM_UNDEFINED)
+    execute_override_property (context, context_property,
+			       grob_property_path,
+			       new_value);
+  else
+    execute_revert_property (context, context_property,
+			     grob_property_path);
+}
+
+void
+execute_revert_property (Context *context,
+			 SCM context_property,
+			 SCM grob_property_path)
+{
+  /*
+    revert.
+  */
+  SCM current_context_val = SCM_EOL;
+  if (context->where_defined (context_property, &current_context_val) == context)
     {
-      SCM current_value = scm_car (current_context_val);
+      SCM current_alist = scm_car (current_context_val);
       SCM daddy = scm_cdr (current_context_val);
 
       if (!scm_is_pair (grob_property_path)
@@ -174,12 +158,29 @@ execute_general_pushpop_property (Context *context,
 	}
       
       SCM symbol = scm_car (grob_property_path);
-      SCM new_alist = evict_from_alist (symbol, current_value, daddy);
 
-      if (new_alist == daddy)
-	context->unset_property (context_property);
+      if (scm_is_pair (scm_cdr (grob_property_path)))
+	{
+	  SCM current_sub_alist = ly_assoc_get (symbol, current_alist, SCM_EOL);
+	  SCM new_val = nested_property_revert_alist (current_sub_alist, scm_cdr (grob_property_path));
+	    
+	  if (scm_is_pair (current_alist)
+	      && scm_caar (current_alist) == symbol
+	      && current_alist != daddy)
+	    current_alist = scm_cdr (current_alist);
+
+	  current_alist = scm_acons (symbol, new_val, current_alist);
+	  scm_set_car_x (current_context_val, current_alist);
+	}
       else
-	context->set_property (context_property, scm_cons (new_alist, daddy));
+	{
+	  SCM new_alist = evict_from_alist (symbol, current_alist, daddy);
+	  
+	  if (new_alist == daddy)
+	    context->unset_property (context_property);
+	  else
+	    context->set_property (context_property, scm_cons (new_alist, daddy));
+	}
     }
 }