* 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 5ebd40984635f351fe87e51624959b9b0620676c..d56a8b53abc4ecd6e33c87b9bf74582fb495cb8f 100644 (file)
--- 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 (file)
index 646c7a4..0000000
--- 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 3df536b42dd4724294b6e5605ee7f350c12f8e72..5d4d03fe34edb969f25b768fcec50a401936e3a8 100644 (file)
--- 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 b969f7478be82e4dc4fecff9107a8890447efb17..4dc2b196c44191ebf501df953cc21845d4b5ac72 100644 (file)
--- 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 8a32a02871c7c42e84c9c0c617253dac7c8cbc91..122b1f2a78d62f97cf4d2747e7a5de4ef8028bb9 100644 (file)
--- 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 2cfd8c8e178cec80c4425527cf81dc9579e6218d..55bb3a6546ccefa0cfe751b842d6399dd04a0570 100644 (file)
--- 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 0a9dc19fcc873919edfbafa8dc8d96f08ed45522..60896a930467eafbf88c6dec2a14325056cc2918 100644 (file)
--- 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)