From: hanwen <hanwen>
Date: Wed, 2 Nov 2005 01:09:02 +0000 (+0000)
Subject: * scm/output-lib.scm (chain-grob-member-functions): replace
X-Git-Tag: release/2.7.16^2~27
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=72d617ea79130cedb880d229834c3374a80423e1;p=lilypond.git

* scm/output-lib.scm (chain-grob-member-functions): replace
chained-callback.cc

* lily/chained-callback.cc (Module): remove file.

* lily/simple-closure.cc: new file. Smob type that allows "grob
member functions",
---

diff --git a/ChangeLog b/ChangeLog
index 5ebd409846..d56a8b53ab 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
 2005-11-02  Han-Wen Nienhuys  <hanwen@xs4all.nl>
 
+	* scm/output-lib.scm (chain-grob-member-functions): replace
+	chained-callback.cc
+
+	* lily/chained-callback.cc (Module): remove file.
+
 	* lily/rest-collision.cc (force_shift_callback_rest): change to
 	chained callback.
 
@@ -21,8 +26,8 @@
 	* lily/include/dimension-cache.hh (class Dimension_cache): remove
 	callback administration.
 
-	* lily/simple-closure.cc: new file. Smob type that allows "grob"
-	member functions
+	* lily/simple-closure.cc: new file. Smob type that allows "grob
+	member functions",
 
 	    (ly:make-simple-closure FUNC A B)
 
diff --git a/lily/chained-callback.cc b/lily/chained-callback.cc
deleted file mode 100644
index 646c7a4bc2..0000000000
--- a/lily/chained-callback.cc
+++ /dev/null
@@ -1,83 +0,0 @@
-/*
-  chained-callback.cc -- chained callbacks.
-
-  source file of the GNU LilyPond music typesetter
-
-  (c) 2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
-
-*/
-
-#include "lily-guile.hh"
-
-static scm_t_bits chain_tag;
-
-bool
-is_callback_chain (SCM s)
-{
-  return (SCM_NIMP (s) && SCM_CELL_TYPE (s) == chain_tag);
-}
-
-SCM
-callback_chain_extract_procedures (SCM chain_smob)
-{
-  assert (is_callback_chain (chain_smob));
-  return (SCM) SCM_CELL_WORD_1(chain_smob);
-}
-
-LY_DEFINE(ly_callback_chain_p, "ly:callback-chain?",
-	  1,0,0, (SCM chain),
-	  "Type predicate.")
-{
-  return scm_from_bool (is_callback_chain (chain));
-}
-
-LY_DEFINE(ly_make_callback_chain, "ly:make-callback-chain",
-	  0, 0, 1, (SCM procedures),
-	  "Make a grob callback chain. @var{procedures} should be a "
-	  "list of procedures taking 2 arguments.")
-{
-  SCM z;
-
-  for (SCM s = procedures;
-       scm_is_pair (s); s = scm_cdr (s))
-    {
-      SCM proc = scm_car (s);
-      if (!ly_is_procedure (proc))
-	{
-	  scm_misc_error ("Must be a procedure: ~a",
-			  "ly:make-callback-chain",
-			  proc);
-	}
-
-      if (procedure_arity (proc) != 2)
-	{
-	  scm_misc_error ("Procedure should take 2 arguments: ~a",
-			  "ly:make-callback-chain",
-			  proc);
-	}
-    }
-  
-  SCM_NEWSMOB(z, chain_tag, procedures);
-  return z;
-}
- 
-int
-print_callback_chain (SCM s, SCM port, scm_print_state *)
-{
-  scm_puts ("#<callback-chain ", port);
-  scm_display (scm_cdr (s), port);
-  scm_puts (" >", port);
-  return 1;
-}
-
-
-void init_chained_callback ()
-{
-  chain_tag = scm_make_smob_type ("callback-chain", 0);
-  scm_set_smob_mark (chain_tag, scm_markcdr);
-  scm_set_smob_print (chain_tag, print_callback_chain);
-};
-
-
-
-ADD_SCM_INIT_FUNC(chain, init_chained_callback);
diff --git a/lily/grob-property.cc b/lily/grob-property.cc
index 3df536b42d..5d4d03fe34 100644
--- a/lily/grob-property.cc
+++ b/lily/grob-property.cc
@@ -136,14 +136,6 @@ Grob::try_callback (SCM sym, SCM proc)
   SCM value = SCM_EOL;
   if (ly_is_procedure (proc))
     value = scm_call_1 (proc, self_scm ());
-  else if (is_callback_chain (proc))
-    {
-      for (SCM s = callback_chain_extract_procedures (proc);
-	   scm_is_pair (s); s = scm_cdr (s))
-	{
-	  value = scm_call_2  (scm_car (s), self_scm (), value);
-	}
-    }
   else if (is_simple_closure (proc))
     {
       value = evaluate_with_simple_closure (self_scm (),
diff --git a/lily/include/grob.hh b/lily/include/grob.hh
index b969f7478b..4dc2b196c4 100644
--- a/lily/include/grob.hh
+++ b/lily/include/grob.hh
@@ -136,9 +136,6 @@ SCM ly_grobs2scm (Link_array<Grob> a);
 
 Interval robust_relative_extent (Grob *, Grob *, Axis);
 
-bool is_callback_chain (SCM s);
-SCM callback_chain_extract_procedures (SCM chain_smob);
-
 
 SCM axis_offset_symbol (Axis a);
 SCM axis_self_offset_symbol (Axis a);
diff --git a/lily/simple-closure.cc b/lily/simple-closure.cc
index 8a32a02871..122b1f2a78 100644
--- a/lily/simple-closure.cc
+++ b/lily/simple-closure.cc
@@ -56,11 +56,15 @@ evaluate_with_simple_closure (SCM delayed_argument,
     return expr;
   else if (scm_car (expr) == ly_symbol2scm ("quote"))
     return scm_cadr (expr);
-  else
+  else if (ly_is_procedure (scm_car (expr)))
     {
-      return scm_apply_0 (scm_car (expr), evaluate_args (delayed_argument, scm_cdr (expr)));
+      return scm_apply_0 (scm_car (expr),
+			  evaluate_args (delayed_argument, scm_cdr (expr)));
     }
-
+  else
+    // ugh. deviation from standard. Should print error? 
+    return  evaluate_args (delayed_argument, scm_cdr (expr)); 
+  
   assert (false);
   return SCM_EOL;
 }
@@ -73,7 +77,7 @@ LY_DEFINE(ly_simple_closure_p, "ly:simple-closure?",
 }
 
 LY_DEFINE(ly_make_simple_closure, "ly:make-simple-closure",
-	  0, 0, 1, (SCM expr),
+	  1, 0, 0, (SCM expr),
 	  "Make a simple closure. @var{expr} should be form of "
 	  "@code{(@var{func} @var{a1} @var{A2} ...)}, and will be invoked "
 	  "as @code{(@var{func} @var{delayed-arg} @var{a1} @var{a2} ... )}.")
diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm
index 2cfd8c8e17..55bb3a6546 100644
--- a/scm/define-grobs.scm
+++ b/scm/define-grobs.scm
@@ -282,14 +282,17 @@
 	;; todo: clean this up a bit: the list is getting
 	;; rather long.
 	(gap . 0.8)
-
-	(positions .  ,(ly:make-callback-chain
-			Beam::calc_least_squares_positions
-			Beam::slope_damping
-			Beam::shift_region_to_valid
-			Beam::quanting
-			Beam::set_stem_lengths
-			))
+	(positions .  ,(ly:make-simple-closure
+			(ly:make-simple-closure
+			 (list chain-grob-member-functions
+			   `(,cons 0 0)
+			   Beam::calc_least_squares_positions
+			   Beam::slope_damping
+			   Beam::shift_region_to_valid
+			   Beam::quanting
+			   Beam::set_stem_lengths
+			   ))))
+	
 	(concaveness . ,Beam::calc_concaveness)
 	(direction . ,Beam::calc_direction)
 	(stencil . ,Beam::print)
diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 0a9dc19fcc..60896a9304 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -282,3 +282,14 @@ centered, X==1 is at the right, X == -1 is at the left."
      (ly:stencil-translate-axis lp (- (car x-ext) padding) X)
      (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X))
   ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+
+(define-public (chain-grob-member-functions grob value . funcs)
+  (for-each
+   (lambda (func)
+     (set! value (func grob value)))
+   funcs)
+
+  value)