From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Sun, 9 Oct 2005 15:28:35 +0000 (+0000)
Subject: * scm/parser-ly-from-scheme.scm: rename from ly-from-scheme.scm
X-Git-Tag: release/2.7.13~38
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=4a4b9008d4e571eb5714314661f5eaf35b117ef0;p=lilypond.git

* scm/parser-ly-from-scheme.scm: rename from ly-from-scheme.scm

* scm/parser-clef.scm (supported-clefs): rename from clef.scm

* scm/layout-slur.scm: rename from slur.scm

* scm/layout-page-layout.scm: rename from page-layout.scm

* scm/layout-beam.scm: rename from beam.scm

* scm/define-grob-interfaces.scm (bass-figure-interface): add
bass-figure-interface

* lily/new-figured-bass-engraver.cc (process_music): add
implicitBassFigures property.

* scm/define-markup-commands.scm (pad-x): new markup.

* ly/engraver-init.ly (AncientRemoveEmptyStaffContext): set
minimumVerticalExtent on FiguredBass context.

* lily/figured-bass-continuation.cc (center_on_figures): kludge in
case the continuation crosses a line break.
---

diff --git a/ChangeLog b/ChangeLog
index f2e57bce55..3f170d6554 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,29 @@
+2005-10-09  Han-Wen Nienhuys  <hanwen@xs4all.nl>
+
+	* scm/parser-ly-from-scheme.scm: rename from ly-from-scheme.scm
+
+	* scm/parser-clef.scm (supported-clefs): rename from clef.scm
+
+	* scm/layout-slur.scm: rename from slur.scm
+
+	* scm/layout-page-layout.scm: rename from page-layout.scm
+
+	* scm/layout-beam.scm: rename from beam.scm
+
+	* scm/define-grob-interfaces.scm (bass-figure-interface): add
+	bass-figure-interface
+
+	* lily/new-figured-bass-engraver.cc (process_music): add
+	implicitBassFigures property.
+	
+	* scm/define-markup-commands.scm (pad-x): new markup.
+
+	* ly/engraver-init.ly (AncientRemoveEmptyStaffContext): set
+	minimumVerticalExtent on FiguredBass context.
+
+	* lily/figured-bass-continuation.cc (center_on_figures): kludge in
+	case the continuation crosses a line break.
+
 2005-10-09  Jan Nieuwenhuizen  <janneke@gnu.org>
 
 	* flower/file-name.cc (dos_to_posix)[__CYGWIN__]: Return
@@ -6,6 +32,8 @@
 
 2005-10-07  Han-Wen Nienhuys  <hanwen@xs4all.nl>
 
+	* VERSION (PACKAGE_NAME): release 2.7.12
+
 	* input/regression/figured-bass-continuation-center.ly: new file.
 
 	* input/regression/beam-outside-beamlets.ly: new file.
diff --git a/VERSION b/VERSION
index 59cd04e448..38bfbcfef3 100644
--- a/VERSION
+++ b/VERSION
@@ -1,6 +1,6 @@
 PACKAGE_NAME=LilyPond
 MAJOR_VERSION=2
 MINOR_VERSION=7
-PATCH_LEVEL=12
+PATCH_LEVEL=13
 MY_PATCH_LEVEL=
 
diff --git a/input/regression/figured-bass-implicit.ly b/input/regression/figured-bass-implicit.ly
new file mode 100644
index 0000000000..92eeed066b
--- /dev/null
+++ b/input/regression/figured-bass-implicit.ly
@@ -0,0 +1,33 @@
+
+\header
+{
+  
+  texidoc = "Implicit bass figures are not printed, but they do get extenders."
+}
+
+
+\version "2.7.13"
+\paper
+{
+  raggedright = ##t
+}
+
+<<
+  \relative c'' \new Voice {
+    c^"normal" c c c^"extenders" c c c_"implicit" c
+    }
+  \figures {
+    <3 6!>
+    <3 4+>
+    r
+    \set useBassFigureExtenders = ##t
+    <3 6!>
+    <3 4+>
+    r
+    \set useBassFigureExtenders = ##t
+    \set implicitBassFigures = #'(3)
+    <3 6!>
+    <3 4+>
+  }  
+>>  
+  
diff --git a/lily/figured-bass-continuation.cc b/lily/figured-bass-continuation.cc
index 1969cf30d5..4001dc5f26 100644
--- a/lily/figured-bass-continuation.cc
+++ b/lily/figured-bass-continuation.cc
@@ -36,10 +36,13 @@ Figured_bass_continuation::center_on_figures (SCM grob, SCM axis)
   (void) axis;
   
   extract_grob_set (me, "figures", figures);
+  if (figures.is_empty ())
+    return scm_from_double (0.0);
   Grob *common = common_refpoint_of_array (figures, me, Y_AXIS);
 
   Interval ext = Axis_group_interface::relative_group_extent (figures, common, Y_AXIS);
-  
+  if (ext.is_empty ())
+    return scm_from_double (0.0);
   return scm_from_double (ext.center () - me->relative_coordinate (common, Y_AXIS));
 }
 
@@ -59,8 +62,13 @@ Figured_bass_continuation::print (SCM grob)
 							X_AXIS);
   do
     {
+      Item *bound = me->get_bound (d);
+      Direction extdir =
+	(d == LEFT && to_boolean (bound->get_property ("implicit")))
+	? LEFT : RIGHT;
+
       spanned[d] 
-	= robust_relative_extent (me->get_bound (d), common, X_AXIS)[RIGHT]
+	= robust_relative_extent (bound, common, X_AXIS)[extdir]
 	- me->relative_coordinate (common, X_AXIS);
     }
   while (flip (&d) !=  LEFT);
diff --git a/lily/new-figured-bass-engraver.cc b/lily/new-figured-bass-engraver.cc
index be5a78cc08..a68a9c18a5 100644
--- a/lily/new-figured-bass-engraver.cc
+++ b/lily/new-figured-bass-engraver.cc
@@ -266,6 +266,7 @@ New_figured_bass_engraver::process_music ()
 
   if (!new_music_found_)
     return ;
+  
   new_music_found_ = false;
 
   /*
@@ -287,7 +288,6 @@ New_figured_bass_engraver::process_music ()
     {
       clear_spanners ();
     }
-
   
   int k = 0;
   for (int i = 0; i < new_musics_.size (); i++)
@@ -321,26 +321,28 @@ New_figured_bass_engraver::process_music ()
       Array<int> junk_continuations;
       for (int i = 0; i < groups_.size(); i++)
 	{
-	  if (groups_[i].is_continuation ())
+	        Figure_group &group = groups_[i];
+
+	  if (group.is_continuation ())
 	    {
-	      if (!groups_[i].continuation_line_)
+	      if (!group.continuation_line_)
 		{
 		  Spanner * line = make_spanner ("BassFigureContinuation", SCM_EOL);
-		  Item * item = groups_[i].figure_item_;
-		  groups_[i].continuation_line_ = line;
+		  Item * item = group.figure_item_;
+		  group.continuation_line_ = line;
 		  line->set_bound (LEFT, item);
 
 		  /*
 		    Don't add as child. This will cache the wrong
 		    (pre-break) stencil when callbacks are triggered.
 		  */
-		  line->set_parent (groups_[i].group_, Y_AXIS);
+		  line->set_parent (group.group_, Y_AXIS);
 		  Pointer_group_interface::add_grob (line, ly_symbol2scm ("figures"), item);
-	      
-		  groups_[i].figure_item_ = 0;
+
+		  group.figure_item_ = 0;
 		}
 	    }
-	  else if (groups_[i].continuation_line_) 
+	  else if (group.continuation_line_) 
 	    junk_continuations.push (i); 
 	}
 
@@ -391,6 +393,7 @@ New_figured_bass_engraver::create_grobs ()
 	    = make_item ("NewBassFigure",
 			 group.current_music_->self_scm ());
 
+	  
 	  SCM fig = group.current_music_->get_property ("figure");
 	  if (!group.group_)
 	    {
@@ -401,6 +404,11 @@ New_figured_bass_engraver::create_grobs ()
 					    Align_interface::alignment_callback_proc);
 	    }
 
+	  if (scm_memq (fig, get_property ("implicitBassFigures")) != SCM_BOOL_F)
+	    {
+	      item->set_property ("transparent", SCM_BOOL_T); 
+	      item->set_property ("implicit", SCM_BOOL_T);
+	    }
 	  
       	  group.number_ = fig;
       	  group.alteration_ = group.current_music_->get_property ("alteration");
@@ -450,6 +458,9 @@ ADD_TRANSLATOR (New_figured_bass_engraver,
 		"bass-figure-event rest-event",
 
 		/* read */
+		"implicitBassFigures "
+		"newFiguredBassFormatter "
+		"figuredBassAlterationDirection "
 		"useBassFigureExtenders",
 
 		/* write */
diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly
index 1fec13a6af..5282fc5104 100644
--- a/ly/engraver-init.ly
+++ b/ly/engraver-init.ly
@@ -551,7 +551,6 @@ AncientRemoveEmptyStaffContext = \context {
   tablatureFormat = #fret-number-tablature-format
 
 %%
-  bassFigureFormatFunction = #format-bass-figure
   newFiguredBassFormatter = #format-new-bass-figure
   metronomeMarkFormatter = #format-metronome-markup
   graceSettings = #`(
@@ -594,7 +593,7 @@ AncientRemoveEmptyStaffContext = \context {
 
 \context {
   \type "Engraver_group"
-  \name FiguredBass 
+  \name "FiguredBass"
 
 %%  \consists "Figured_bass_engraver"
   \consists "New_figured_bass_engraver"
@@ -603,6 +602,7 @@ AncientRemoveEmptyStaffContext = \context {
   \consists "Separating_line_group_engraver"
   \consists "Hara_kiri_engraver"
   \override RemoveEmptyVerticalGroup #'remove-first = ##t
+  minimumVerticalExtent = #'(-0.5 . 2.5)
 }
 
 \context {
diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm
deleted file mode 100644
index dd71afdb6e..0000000000
--- a/scm/bass-figure.scm
+++ /dev/null
@@ -1,101 +0,0 @@
-;;;; bass-figure.scm -- implement Scheme output routines for TeX
-;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 1998--2005 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;;                 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-
-
-(ly:add-interface
- 'bass-figure-interface
- "A bass figure, including bracket"
- '())
-
-
-(define-public (format-new-bass-figure figure event context)
-  (let* ((fig (ly:music-property event 'figure))
-	 (fig-markup (if (number? figure)
-			 (markup #:number (number->string figure 10))
-			 #f
-			 ))
-
-	 (alt (ly:music-property event 'alteration))
-	 (alt-markup
-	  (if (number? alt)
-	      (markup
-		      #:general-align Y DOWN #:smaller #:smaller
-		      (alteration->text-accidental-markup alt))
-	      
-	      #f))
-	 (alt-dir (ly:context-property context 'figuredBassAlterationDirection))
-	 )
-
-    (if (and (not fig-markup) alt-markup)
-	(begin
-	  (set! fig-markup (markup #:left-align #:pad-around 0.3 alt-markup))
-	  (set! alt-markup #f)))
-
-
-    ;; hmm, how to get figures centered between note, and
-    ;; lone accidentals too?
-    
-    ;;    (if (markup? fig-markup)
-    ;;	(set!
-    ;;	 fig-markup (markup #:translate (cons 1.0 0)
-    ;;			    #:hcenter fig-markup)))
-
-    (if alt-markup
-	(set! fig-markup
-	      (markup #:put-adjacent
-		      fig-markup X
-		      (if (number? alt-dir)
-			  alt-dir
-			  LEFT)
-		      #:pad-around 0.2 alt-markup
-		      )))
-
-    (if (markup?  fig-markup)
-	fig-markup
-	empty-markup)))
-
-(define-public (format-bass-figure figures context grob)
-  ;; TODO: support slashed numerals here.
-  (define (fig-to-markup fig-music)
-    (let* ((align-accs
-	    (eq? #t (ly:context-property context 'alignBassFigureAccidentals)))
-	   (fig (ly:music-property fig-music 'figure))
-	   (acc (ly:music-property fig-music 'alteration))
-	   (acc-markup #f)
-	   (fig-markup
-	    (if (markup? fig)
-		fig
-		(if align-accs (make-simple-markup " ")
-		    (if (not (eq? acc '()))
-			(make-simple-markup "")
-			(make-strut-markup))))))
-
-      (if (number? acc)
-	  (make-line-markup (list fig-markup
-				  (alteration->text-accidental-markup acc)))
-	  fig-markup)))
-
-  (define (filter-brackets i figs acc)
-    (cond
-     ((null? figs) acc)
-     (else
-      (filter-brackets (1+ i) (cdr figs)
-
-		       (append
-			(if (eq? (ly:music-property (car figs) 'bracket-start) #t)
-			     (list i)
-			     '())
-			(if (eq? (ly:music-property (car figs) 'bracket-stop) #t)
-			     (list i)
-			     '())
-			
-			acc)))))
-
-  (set! (ly:grob-property grob 'text)
-	(make-bracketed-y-column-markup
-	 (sort (filter-brackets 0 figures '()) <)
-	 (map fig-to-markup figures))))
diff --git a/scm/beam.scm b/scm/beam.scm
deleted file mode 100644
index e92edc0e84..0000000000
--- a/scm/beam.scm
+++ /dev/null
@@ -1,115 +0,0 @@
-;;;;
-;;;; beam.scm -- Beam scheme stuff
-;;;;
-;;;; source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 2000--2005 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;;
-
-;;
-;; width in staff space.
-;;
-(define (beam-flag-width-function type)
-  (cond
-   ((eq? type 1) 1.98) 
-   ((eq? type 1) 1.65) ;; FIXME: check what this should be and why
-   (else 1.32)))
-
-;; There are several ways to calculate the direction of a beam
-;;
-;; * majority: number count of up or down notes
-;; * mean    : mean centre distance of all notes
-;; * median  : mean centre distance weighted per note
-;;
-;; [Ross] states that the majority of the notes dictates the
-;; direction (and not the mean of "center distance")
-;;
-;; But is that because it really looks better, or because he wants
-;; to provide some real simple hands-on rules?
-;;     
-;; We have our doubts, so we simply provide all sensible alternatives.
-
-
-;;
-;; DOCME: what goes into this func, what comes out.
-(define (dir-compare up down)
-  (sign (- up down)))
-
-;; arguments are in the form (up . down)
-(define-public (beam-dir-majority count total)
-  (dir-compare (car count) (cdr count)))
-
-(define-public (beam-dir-majority-median count total)
-  "First try majority. If that doesn't work, try median."
-  (let ((maj (dir-compare (car count) (cdr count))))
-    (if (not (= maj 0))
-	maj
-	(beam-dir-median count total))))
-
-(define-public (beam-dir-mean count total)
-  (dir-compare (car total) (cdr total)))
-
-(define-public (beam-dir-median count total)
-  (if (and (> (car count) 0)
-	   (> (cdr count) 0))
-      (dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count)))
-      (dir-compare (car count) (cdr count))))
-
-(define ((check-beam-quant posl posr) beam)
-  "Check whether BEAM has POSL and POSR quants.  POSL are (POSITION
-. QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter) 
-
-"
-  (let* ((posns (ly:grob-property beam 'positions))
-	 (thick (ly:grob-property beam 'thickness))
-	 (layout (ly:grob-layout beam))
-	 (lthick (ly:output-def-lookup layout 'linethickness))
-	 (staff-thick lthick) ; fixme.
-	 (quant->coord (lambda (p q)
-			 (if (= 2 (abs q))
-			     (+ p (/ q 4.0))
-			     (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
-	 (want-l (quant->coord (car posl) (cdr posl))) 
-	 (want-r (quant->coord (car posr) (cdr posr)))
-	 (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
-    
-    (if (or (not (almost-equal want-l (car posns)))
-	    (not (almost-equal want-r (cdr posns))))
-	(begin
-	  (ly:warning (_ "Error in beam quanting.  Expected (~S,~S) found ~S.")
-		      want-l want-r posns)
-	  (set! (ly:grob-property beam 'quant-score)
-		(format "(~S,~S)" want-l want-r)))
-	(set! (ly:grob-property beam 'quant-score) ""))))
-
-(define ((check-beam-slope-sign comparison) beam)
-  "Check whether the slope of BEAM is correct wrt. COMPARISON."
-  (let* ((posns (ly:grob-property beam 'positions))
-	 (slope-sign (- (cdr posns) (car posns)))
-	 (correct (comparison slope-sign 0)))
-
-    (if (not correct)
-	(begin
-	  (ly:warning (_ "Error in beam quanting.  Expected ~S 0, found ~S.")
-		      (procedure-name comparison) "0" slope-sign)
-	  (set! (ly:grob-property beam 'quant-score)
-		(format "~S 0" (procedure-name comparison))))
-	(set! (ly:grob-property beam 'quant-score) ""))))
-
-(define-public (check-quant-callbacks l r)
-  (list Beam::least_squares
-	Beam::check_concave
-	Beam::slope_damping
-	Beam::shift_region_to_valid
-	Beam::quanting
-	(check-beam-quant l r)))
-
-
-(define-public (check-slope-callbacks comparison)
-  (list Beam::least_squares
-	Beam::check_concave
-	Beam::slope_damping
-	Beam::shift_region_to_valid
-	Beam::quanting
-	(check-beam-slope-sign comparison)))
-
diff --git a/scm/clef.scm b/scm/clef.scm
deleted file mode 100644
index aeb34db579..0000000000
--- a/scm/clef.scm
+++ /dev/null
@@ -1,127 +0,0 @@
-;;;; clef.scm -- Clef settings
-;;;;
-;;;; source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 2004--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-
-
-;; (name . (glyph clef-position octavation))
-;;
-;; -- the name clefOctavation is misleading. The value 7 is 1 octave,
-;; not 7 Octaves.
-(define-public supported-clefs
-  '(("treble" . ("clefs.G" -2 0))
-    ("violin" . ("clefs.G" -2 0))
-    ("G" . ("clefs.G" -2 0))
-    ("G2" . ("clefs.G" -2 0))
-    ("french" . ("clefs.G" -4 0))
-    ("soprano" . ("clefs.C" -4 0))
-    ("mezzosoprano" . ("clefs.C" -2 0))
-    ("alto" . ("clefs.C" 0 0))
-    ("C" . ("clefs.C" 0 0))
-    ("tenor" . ("clefs.C" 2 0))
-    ("baritone" . ("clefs.C" 4 0))
-    ("varbaritone" . ("clefs.F" 0 0))
-    ("bass" . ("clefs.F" 2 0))
-    ("F" . ("clefs.F" 2 0))
-    ("subbass" . ("clefs.F" 4 0))
-    ("percussion" . ("clefs.percussion" 0 0))
-    ("tab" . ("clefs.tab" 0 0))
-
-    ;; should move mensural stuff to separate file?
-    ("vaticana-do1" . ("clefs.vaticana.do" -1 0))
-    ("vaticana-do2" . ("clefs.vaticana.do" 1 0))
-    ("vaticana-do3" . ("clefs.vaticana.do" 3 0))
-    ("vaticana-fa1" . ("clefs.vaticana.fa" -1 0))
-    ("vaticana-fa2" . ("clefs.vaticana.fa" 1 0))
-    ("medicaea-do1" . ("clefs.medicaea.do" -1 0))
-    ("medicaea-do2" . ("clefs.medicaea.do" 1 0))
-    ("medicaea-do3" . ("clefs.medicaea.do" 3 0))
-    ("medicaea-fa1" . ("clefs.medicaea.fa" -1 0))
-    ("medicaea-fa2" . ("clefs.medicaea.fa" 1 0))
-    ("hufnagel-do1" . ("clefs.hufnagel.do" -1 0))
-    ("hufnagel-do2" . ("clefs.hufnagel.do" 1 0))
-    ("hufnagel-do3" . ("clefs.hufnagel.do" 3 0))
-    ("hufnagel-fa1" . ("clefs.hufnagel.fa" -1 0))
-    ("hufnagel-fa2" . ("clefs.hufnagel.fa" 1 0))
-    ("hufnagel-do-fa" . ("clefs.hufnagel.do.fa" 4 0))
-    ("mensural-c1" . ("clefs.mensural.c" -2 0))
-    ("mensural-c2" . ("clefs.mensural.c" 0 0))
-    ("mensural-c3" . ("clefs.mensural.c" 2 0))
-    ("mensural-c4" . ("clefs.mensural.c" 4 0))
-    ("mensural-f" . ("clefs.mensural.f" 2 0))
-    ("mensural-g" . ("clefs.mensural.g" -2 0))
-    ("neomensural-c1" . ("clefs.neomensural.c" -4 0))
-    ("neomensural-c2" . ("clefs.neomensural.c" -2 0))
-    ("neomensural-c3" . ("clefs.neomensural.c" 0 0))
-    ("neomensural-c4" . ("clefs.neomensural.c" 2 0))
-    ("petrucci-c1" . ("clefs.petrucci.c1" -4 0))
-    ("petrucci-c2" . ("clefs.petrucci.c2" -2 0))
-    ("petrucci-c3" . ("clefs.petrucci.c3" 0 0))
-    ("petrucci-c4" . ("clefs.petrucci.c4" 2 0))
-    ("petrucci-c5" . ("clefs.petrucci.c5" 4 0))
-    ("petrucci-f" . ("clefs.petrucci.f" 2 0))
-    ("petrucci-g" . ("clefs.petrucci.g" -2 0))))
-
-;; "an alist mapping GLYPHNAME to the position of the middle C for
-;; that symbol"
-(define c0-pitch-alist
-  '(("clefs.G" . -4)
-    ("clefs.C" . 0)
-    ("clefs.F" . 4)
-    ("clefs.percussion" . 0)
-    ("clefs.tab" . 0 )
-    ("clefs.vaticana.do" . 0)
-    ("clefs.vaticana.fa" . 4)
-    ("clefs.medicaea.do" . 0)
-    ("clefs.medicaea.fa" . 4)
-    ("clefs.hufnagel.do" . 0)
-    ("clefs.hufnagel.fa" . 4)
-    ("clefs.hufnagel.do.fa" . 0)
-    ("clefs.mensural.c" . 0)
-    ("clefs.mensural.f" . 4)
-    ("clefs.mensural.g" . -4)
-    ("clefs.neomensural.c" . 0)
-    ("clefs.petrucci.c1" . 0)
-    ("clefs.petrucci.c2" . 0)
-    ("clefs.petrucci.c3" . 0)
-    ("clefs.petrucci.c4" . 0)
-    ("clefs.petrucci.c5" . 0)
-    ("clefs.petrucci.f" . 4)
-    ("clefs.petrucci.g" . -4)))
-
-(define-public (make-clef-set clef-name)
-  "Generate the clef setting commands for a clef with name CLEF-NAME."
-  (define (make-prop-set props)
-    (let ((m (make-music 'PropertySet)))
-      (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
-      m))
-  (let ((e '())
-	(c0 0)
-	(oct 0)
-	(match (string-match "^(.*)([_^])([0-9]+)$" clef-name)))
-    (if match
-	(begin
-	  (set! clef-name (match:substring match 1))
-	  (set! oct
-		(* (if (equal? (match:substring match 2) "^") -1 1)
-		   (- (string->number (match:substring match 3)) 1)))))
-    (set! e (assoc clef-name supported-clefs))
-    (if (pair? e)
-	(let* ((musics (map make-prop-set
-			    `(((symbol . clefGlyph) (value . ,(cadr e)))
-			      ((symbol . middleCPosition)
-			       (value . ,(+ oct
-					    (caddr e)
-					    (cdr (assoc (cadr e) c0-pitch-alist)))))
-			      ((symbol . clefPosition) (value . ,(caddr e)))
-			      ((symbol . clefOctavation) (value . ,(- oct))))))
-	       (seq (make-music 'SequentialMusic
-				'elements musics))
-	       (csp (make-music 'ContextSpeccedMusic)))
-	  (context-spec-music seq 'Staff))
-	(begin
-	  (ly:warning (_ "unknown clef type `~a'") clef-name)
-	  (ly:warning (_ "see scm/clef.scm for supported clefs"))
-	  (make-music 'Music)))))
-
diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm
index 1452221f3d..73c6b0d630 100644
--- a/scm/define-context-properties.scm
+++ b/scm/define-context-properties.scm
@@ -239,6 +239,10 @@ selector for tab notation.")
 
      (ignoreBarChecks ,boolean? "Ignore bar checks")
      (ignoreMelismata ,boolean? "Ignore melismata for this @internalsref{Lyrics} line.")
+
+     (implicitBassFigures ,list? "List of bass figures that are not
+printed as numbers, but only as extender lines.")
+     
      (instr ,markup? "See @code{instrument}")
 
      (instrument ,markup? "The name to print left of a staff.  The
diff --git a/scm/define-grob-interfaces.scm b/scm/define-grob-interfaces.scm
index 9d5f7b9ddb..210b4552a0 100644
--- a/scm/define-grob-interfaces.scm
+++ b/scm/define-grob-interfaces.scm
@@ -106,6 +106,11 @@ are interesting enough to maintain a hara-kiri staff."
  "A stanza number, to be put in from of a lyrics line"
  '())
 
+(ly:add-interface
+ 'bass-figure-interface
+ "A bass figure text"
+ '(implicit))
+
 ;;; todo: this is not typesetting info. Move to interpretation.
 (ly:add-interface
  'tablature-interface
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index 02d96c137b..fe7c4f39ce 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -281,7 +281,7 @@ Choices are @code{around}, @code{inside}, @code{outside}.  If unset, script
 and slur ignore eachother.")
      (inspect-quants ,number-pair? "If debugging is set,
 set beam quant to this position, and print the respective scores.")
-
+     (implicit ,boolean? "Is this an implicit bass figure?")
      (keep-inside-line ,boolean? "If set, this column cannot have
 things sticking into the margin.")
      (kern ,ly:dimension? "Amount of extra white space to add. For
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 484a1c3d88..ccb03a499a 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -643,6 +643,23 @@ alignment accordingly."
 		     (interval-widen x amount)
 		     (interval-widen y amount))
    ))
+
+
+(def-markup-command (pad-x layout props amount arg) (number? markup?)
+
+  "Add padding @var{amount} around @var{arg} in the X-direction. "
+  (let*
+      ((m (interpret-markup layout props arg))
+       (x (ly:stencil-extent m X))
+       (y (ly:stencil-extent m Y)))
+    
+       
+    (ly:make-stencil (ly:stencil-expr m)
+		     (interval-widen x amount)
+		     y)
+   ))
+
+
 (def-markup-command (put-adjacent layout props arg1 axis dir arg2) (markup? integer? ly:dir?  markup?)
 
   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}.  "
@@ -653,6 +670,19 @@ alignment accordingly."
     (ly:stencil-combine-at-edge m1 axis dir m2 0.0 0.0)
   ))
 
+(def-markup-command (transparent layout props arg) (markup?)
+  "Make the argument transparent"
+  (let*
+      ((m (interpret-markup layout props arg))
+       (x (ly:stencil-extent m X))
+       (y (ly:stencil-extent m Y)))
+    
+
+    
+    (ly:make-stencil ""
+		     x y)))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; property
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/scm/layout-beam.scm b/scm/layout-beam.scm
new file mode 100644
index 0000000000..e92edc0e84
--- /dev/null
+++ b/scm/layout-beam.scm
@@ -0,0 +1,115 @@
+;;;;
+;;;; beam.scm -- Beam scheme stuff
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;; 
+;;;; (c) 2000--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;
+
+;;
+;; width in staff space.
+;;
+(define (beam-flag-width-function type)
+  (cond
+   ((eq? type 1) 1.98) 
+   ((eq? type 1) 1.65) ;; FIXME: check what this should be and why
+   (else 1.32)))
+
+;; There are several ways to calculate the direction of a beam
+;;
+;; * majority: number count of up or down notes
+;; * mean    : mean centre distance of all notes
+;; * median  : mean centre distance weighted per note
+;;
+;; [Ross] states that the majority of the notes dictates the
+;; direction (and not the mean of "center distance")
+;;
+;; But is that because it really looks better, or because he wants
+;; to provide some real simple hands-on rules?
+;;     
+;; We have our doubts, so we simply provide all sensible alternatives.
+
+
+;;
+;; DOCME: what goes into this func, what comes out.
+(define (dir-compare up down)
+  (sign (- up down)))
+
+;; arguments are in the form (up . down)
+(define-public (beam-dir-majority count total)
+  (dir-compare (car count) (cdr count)))
+
+(define-public (beam-dir-majority-median count total)
+  "First try majority. If that doesn't work, try median."
+  (let ((maj (dir-compare (car count) (cdr count))))
+    (if (not (= maj 0))
+	maj
+	(beam-dir-median count total))))
+
+(define-public (beam-dir-mean count total)
+  (dir-compare (car total) (cdr total)))
+
+(define-public (beam-dir-median count total)
+  (if (and (> (car count) 0)
+	   (> (cdr count) 0))
+      (dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count)))
+      (dir-compare (car count) (cdr count))))
+
+(define ((check-beam-quant posl posr) beam)
+  "Check whether BEAM has POSL and POSR quants.  POSL are (POSITION
+. QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter) 
+
+"
+  (let* ((posns (ly:grob-property beam 'positions))
+	 (thick (ly:grob-property beam 'thickness))
+	 (layout (ly:grob-layout beam))
+	 (lthick (ly:output-def-lookup layout 'linethickness))
+	 (staff-thick lthick) ; fixme.
+	 (quant->coord (lambda (p q)
+			 (if (= 2 (abs q))
+			     (+ p (/ q 4.0))
+			     (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
+	 (want-l (quant->coord (car posl) (cdr posl))) 
+	 (want-r (quant->coord (car posr) (cdr posr)))
+	 (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
+    
+    (if (or (not (almost-equal want-l (car posns)))
+	    (not (almost-equal want-r (cdr posns))))
+	(begin
+	  (ly:warning (_ "Error in beam quanting.  Expected (~S,~S) found ~S.")
+		      want-l want-r posns)
+	  (set! (ly:grob-property beam 'quant-score)
+		(format "(~S,~S)" want-l want-r)))
+	(set! (ly:grob-property beam 'quant-score) ""))))
+
+(define ((check-beam-slope-sign comparison) beam)
+  "Check whether the slope of BEAM is correct wrt. COMPARISON."
+  (let* ((posns (ly:grob-property beam 'positions))
+	 (slope-sign (- (cdr posns) (car posns)))
+	 (correct (comparison slope-sign 0)))
+
+    (if (not correct)
+	(begin
+	  (ly:warning (_ "Error in beam quanting.  Expected ~S 0, found ~S.")
+		      (procedure-name comparison) "0" slope-sign)
+	  (set! (ly:grob-property beam 'quant-score)
+		(format "~S 0" (procedure-name comparison))))
+	(set! (ly:grob-property beam 'quant-score) ""))))
+
+(define-public (check-quant-callbacks l r)
+  (list Beam::least_squares
+	Beam::check_concave
+	Beam::slope_damping
+	Beam::shift_region_to_valid
+	Beam::quanting
+	(check-beam-quant l r)))
+
+
+(define-public (check-slope-callbacks comparison)
+  (list Beam::least_squares
+	Beam::check_concave
+	Beam::slope_damping
+	Beam::shift_region_to_valid
+	Beam::quanting
+	(check-beam-slope-sign comparison)))
+
diff --git a/scm/layout-page-layout.scm b/scm/layout-page-layout.scm
new file mode 100644
index 0000000000..64259c0263
--- /dev/null
+++ b/scm/layout-page-layout.scm
@@ -0,0 +1,731 @@
+;;;; page-layout.scm -- page breaking and page layout
+;;;;
+;;;;  source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2004--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;          Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+(use-modules (oop goops describe)
+	     (oop goops))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-class <optimally-broken-page-node> ()
+  (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev)
+  (page #:init-value 0 #:accessor node-page-number #:init-keyword #:pageno)
+  (force #:init-value 0 #:accessor node-force #:init-keyword #:force)
+  (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty)
+  (configuration #:init-value '() #:accessor node-configuration #:init-keyword #:configuration)
+  (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines))
+
+(define-method (display (node <optimally-broken-page-node>) port)
+  (map (lambda (x) (display x port))
+       (list
+	"Page " (node-page-number node)
+	" Lines: " (node-lines node)
+	" Penalty " (node-penalty node)
+	"\n")))
+
+(define-method (node-system-numbers (node <optimally-broken-page-node>))
+  (map (lambda (ps) (ly:paper-system-property ps 'number))
+       (node-lines node)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (annotate? layout)
+  (eq? #t (ly:output-def-lookup layout 'annotatespacing)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (paper-system-staff-extents ps)
+  (ly:paper-system-property ps 'refpoint-Y-extent '(0 . 0)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ANNOTATIONS
+;;
+;; annotations are arrows indicating the numerical value of
+;; spacing variables 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (annotate-y-interval layout name extent is-length?)
+  ;; do something sensible for 0,0 intervals. 
+  (set! extent (interval-widen extent 0.001))
+  (let*
+      ((text-props (cons
+		    '((font-size . -3)
+		      (font-family . typewriter))
+		    (layout-extract-page-properties layout)))
+       (annotation (interpret-markup
+		    layout text-props
+		    (make-column-markup
+		     (list
+		      (make-whiteout-markup (make-simple-markup name))
+		      (make-whiteout-markup
+		       (make-simple-markup
+			(if is-length?
+			    (format "~$" (interval-length extent))
+			    (format "(~$,~$)" (car extent)
+				    (cdr extent)))))))))
+       (arrows
+	(ly:stencil-translate-axis 
+	 (dimension-arrows (cons 0 (interval-length extent)))
+	 (interval-start extent) Y)))
+
+    (set! annotation
+	  (ly:stencil-aligned-to annotation Y CENTER))
+    
+    (set! annotation (ly:stencil-translate annotation
+			  (cons 0 (interval-center extent))))
+
+    (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5 0)
+    ))
+
+(define (paper-system-annotate-last system layout)
+  (let*
+      ((bottomspace (ly:paper-system-property system 'bottom-space))
+       (y-extent (paper-system-extent system Y))
+       (x-extent (paper-system-extent system X))
+       (stencil (ly:paper-system-property system 'stencil))
+     
+       (arrow (if (number? bottomspace)
+	       (annotate-y-interval layout
+				    "bottom-space"
+				    (cons (- (car y-extent) bottomspace)
+					  (car y-extent))
+				    #t)
+	       #f)))
+    
+    (if arrow
+	(set! stencil
+	      (ly:stencil-add stencil arrow)))
+
+    (set! (ly:paper-system-property system 'stencil)
+	  stencil)
+  ))
+  
+(define (paper-system-annotate system layout)
+  "Add arrows and texts to indicate which lengths are set."
+  (let*
+      ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
+       (append-stencil
+	(lambda (a b)
+	  (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
+
+       (annotate-property
+	(lambda (name extent is-length?)
+	  (set! annotations
+		(append-stencil annotations
+				(annotate-y-interval layout
+						     name extent is-length?)))))
+
+       (bbox-extent (paper-system-extent system Y))
+       (refp-extent (ly:paper-system-property system 'refpoint-Y-extent))
+       (next-space (ly:paper-system-property system 'next-space
+					     (ly:output-def-lookup layout 'betweensystemspace)
+					     ))
+       (next-padding (ly:paper-system-property system 'next-padding
+					       (ly:output-def-lookup layout 'betweensystempadding)
+					       ))
+		     
+       )
+
+    (if (number-pair? bbox-extent)
+	(begin
+	  (annotate-property  "Y-extent"
+			       bbox-extent #f)
+	  (annotate-property  "next-padding"
+			     (interval-translate (cons (- next-padding) 0) (car bbox-extent))
+			     #t)))
+    
+    ;; titles don't have a refpoint-Y-extent.
+    (if (number-pair? refp-extent)
+	(begin
+	  (annotate-property "refpoint-Y-extent"
+			     refp-extent #f)
+	
+	  (annotate-property "next-space"
+			     (interval-translate (cons (- next-space) 0) (car refp-extent))
+		       #t)))
+	
+    
+
+    (set! (ly:paper-system-property system 'stencil)
+	  (ly:stencil-add
+	   (ly:paper-system-property system 'stencil)
+	   (ly:make-stencil
+	    (ly:stencil-expr annotations)
+	    (ly:stencil-extent empty-stencil X)
+	    (ly:stencil-extent empty-stencil Y)
+	    )))
+    
+    ))
+
+(define (annotate-page layout stencil)
+  (let*
+      ((topmargin (ly:output-def-lookup layout 'topmargin))
+       (vsize (ly:output-def-lookup layout 'vsize))
+       (bottommargin (ly:output-def-lookup layout 'bottommargin))
+       (add-stencil (lambda (y)
+		      (set! stencil
+			    (ly:stencil-add stencil y))
+		      )))
+
+    (add-stencil
+     (ly:stencil-translate-axis 
+      (annotate-y-interval layout "vsize"
+			   (cons (- vsize) 0)
+			   #t)
+      1 X))
+    
+    (add-stencil
+     (ly:stencil-translate-axis 
+      (annotate-y-interval layout "topmargin"
+			   (cons (- topmargin) 0)
+			   #t)
+      2 X))
+    
+    (add-stencil
+     (ly:stencil-translate-axis 
+      (annotate-y-interval layout "bottommargin"
+			   (cons (- vsize) (- bottommargin vsize))
+			   #t)
+      2 X))
+    
+    stencil))
+
+(define (annotate-space-left page-stencil layout bottom-edge)
+  (let*
+      ((arrow (annotate-y-interval layout
+				"space left"
+				(cons (- bottom-edge)  (car (ly:stencil-extent page-stencil Y)))
+				#t)))
+    
+    (set! arrow (ly:stencil-translate-axis arrow 8 X))
+    (ly:stencil-add page-stencil arrow)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define (page-headfoot layout scopes number
+		       sym separation-symbol dir last?)
+  "Create a stencil including separating space."
+
+  (let* ((header-proc (ly:output-def-lookup layout sym))
+	 (sep (ly:output-def-lookup layout separation-symbol))
+	 (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
+	 (head-stencil
+	  (if (procedure? header-proc)
+	      (header-proc layout scopes number last?)
+	      #f))
+	 )
+    
+    (if (and (number? sep)
+	     (ly:stencil? head-stencil)
+	     (not (ly:stencil-empty? head-stencil)))
+
+	(begin
+	  (set! head-stencil
+		(ly:stencil-combine-at-edge
+		 stencil Y dir head-stencil
+		 sep 0.0))
+
+	  
+	  ;; add arrow markers 
+	  (if (annotate? layout)
+	      (set! head-stencil
+		    (ly:stencil-add
+		     (ly:stencil-translate-axis
+		      (annotate-y-interval layout 
+					   (symbol->string separation-symbol)
+					   (cons (min 0 (* dir sep))
+						 (max 0 (* dir sep)))
+					   #t)
+		      (/ (ly:output-def-lookup layout 'linewidth) 2)
+		      X)
+		     head-stencil
+		     ))
+	      )))
+
+    head-stencil))
+
+(define-public (default-page-music-height layout scopes number last?)
+  "Printable area for music and titles; matches default-page-make-stencil."
+  (let* ((h (- (ly:output-def-lookup layout 'vsize)
+	       (ly:output-def-lookup layout 'topmargin)
+	       (ly:output-def-lookup layout 'bottommargin)))
+	 
+       (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
+       (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
+       (available
+	(- h (if (ly:stencil? head)
+		 (interval-length (ly:stencil-extent head Y))
+		 0)
+	   (if (ly:stencil? foot)
+	       (interval-length (ly:stencil-extent foot Y))
+	       0))))
+
+    ;; (display (list "\n available" available head foot))
+    available))
+
+(define-public (default-page-make-stencil
+		 lines offsets layout scopes number last?)
+  "Construct a stencil representing the page from LINES.
+
+ Offsets is a list of increasing numbers. They must be negated to
+create offsets.
+ "
+
+  (let* ((topmargin (ly:output-def-lookup layout 'topmargin))
+
+       ;; TODO: naming vsize/hsize not analogous to TeX.
+
+	 (vsize (ly:output-def-lookup layout 'vsize))
+	 (hsize (ly:output-def-lookup layout 'hsize))
+	 
+	 (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0))
+	 (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
+	 (system-separator-stencil (if (markup? system-separator-markup)
+				       (interpret-markup layout
+							 (layout-extract-page-properties layout)
+							 system-separator-markup)
+				       #f))
+	 (lmargin (ly:output-def-lookup layout 'leftmargin))
+	 (leftmargin (if lmargin
+			 lmargin
+			 (/ (- hsize
+			       (ly:output-def-lookup layout 'linewidth)) 2)))
+
+	 (rightmargin (ly:output-def-lookup layout 'rightmargin))
+	 (bottom-edge (- vsize
+			 (ly:output-def-lookup layout 'bottommargin)))
+
+	 (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
+	 (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
+
+	 (head-height (if (ly:stencil? head)
+			  (interval-length (ly:stencil-extent head Y))
+			  0.0))
+
+	 (height-proc (ly:output-def-lookup layout 'page-music-height))
+
+	 (page-stencil (ly:make-stencil '()
+					(cons leftmargin hsize)
+					(cons (- topmargin) 0)))
+	 (last-system #f)
+	 (last-y 0.0)
+	 (add-to-page (lambda (stencil y)
+			(set! page-stencil
+			      (ly:stencil-add page-stencil
+					      (ly:stencil-translate stencil
+								    (cons
+								     system-xoffset
+								     (- 0 head-height y topmargin))
+
+								    )))))
+	 (add-system
+	  (lambda (stencil-position)
+	    (let* ((system (car stencil-position))
+		   (stencil (paper-system-stencil system))
+		   (y (cadr stencil-position))
+		   (is-title (paper-system-title?
+			      (car stencil-position))))
+	      (add-to-page stencil y)
+	      (if (and (ly:stencil? system-separator-stencil)
+		       last-system
+		       (not (paper-system-title? system))
+		       (not (paper-system-title? last-system)))
+		  (add-to-page
+		   system-separator-stencil
+		   (average (- last-y
+			       (car (paper-system-staff-extents last-system)))
+			    (- y
+			       (cdr (paper-system-staff-extents system))))))
+	      (set! last-system system)
+	      (set! last-y y))))
+	 )
+
+
+    (if (annotate? layout)
+	(begin
+	  (for-each (lambda (sys) (paper-system-annotate sys layout))
+		    lines)
+	  (paper-system-annotate-last (car (last-pair lines)) layout)))
+  
+    
+    (if #f
+	(display (list
+		  "leftmargin " leftmargin "rightmargin " rightmargin
+		  )))
+
+    (set! page-stencil (ly:stencil-combine-at-edge
+			page-stencil Y DOWN
+			(if (and
+			     (ly:stencil? head)
+			     (not (ly:stencil-empty? head)))
+			    head
+			    (ly:make-stencil "" (cons 0 0) (cons 0 0)))
+			    0. 0.))
+
+    (map add-system (zip lines offsets))
+
+    (if (annotate? layout)
+	(set!
+	 page-stencil
+	 (annotate-space-left page-stencil layout
+			      (- bottom-edge
+				 (if (ly:stencil? foot)
+				     (interval-length (ly:stencil-extent foot Y))
+				     0)))
+	 ))
+
+    
+    (if (and (ly:stencil? foot)
+	     (not (ly:stencil-empty? foot)))
+	(set! page-stencil
+	      (ly:stencil-add
+	       page-stencil
+	       (ly:stencil-translate
+		foot
+		(cons 0
+		      (+ (- bottom-edge)
+			 (- (car (ly:stencil-extent foot Y)))))))))
+
+    (set! page-stencil
+	  (ly:stencil-translate page-stencil (cons leftmargin 0)))
+
+    ;; annotation.
+    (if (annotate? layout)
+	(set! page-stencil (annotate-page layout page-stencil)))
+    
+
+    page-stencil))
+
+;;; optimal page breaking
+
+;;; This is not optimal page breaking, this is optimal distribution of
+;;; lines over pages; line breaks are a given.
+
+;; TODO:
+;;
+;; - density scoring
+;; - separate function for word-wrap style breaking?
+;; - raggedbottom? raggedlastbottom?
+
+(define-public (optimal-page-breaks lines paper-book)
+  "Return pages as a list starting with 1st page. Each page is a list
+of lines. "
+
+  (define MAXPENALTY 1e9)
+  (define paper (ly:paper-book-paper paper-book))
+  (define scopes (ly:paper-book-scopes paper-book))
+  (define force-equalization-factor #f)
+
+  (define (page-height page-number last?)
+    (let ((p (ly:output-def-lookup paper 'page-music-height)))
+
+      (if (procedure? p)
+	  (p paper scopes page-number last?)
+	  10000)))
+
+  (define (get-path node done)
+    "Follow NODE.PREV, and return as an ascending list of pages. DONE
+is what have collected so far, and has ascending page numbers."
+
+    (if (is-a? node <optimally-broken-page-node>)
+	(get-path (node-prev node) (cons node done))
+	done))
+
+  (define (combine-penalties force user best-paths)
+    (let* ((prev-force (if (null? best-paths)
+			   0.0
+			   (node-force (car best-paths))))
+	   (prev-penalty (if (null? best-paths)
+			     0.0
+			     (node-penalty (car best-paths))))
+	 (inter-system-space (ly:output-def-lookup paper 'betweensystemspace))
+	 (relative-force (/ force inter-system-space))
+	 (abs-relative-force (abs relative-force)))
+
+
+      (+ (* abs-relative-force (+ abs-relative-force 1))
+	 prev-penalty
+	 (* force-equalization-factor (/ (abs (- prev-force force))
+					 inter-system-space))
+	 user)))
+
+  (define (space-systems page-height lines ragged?)
+    (let* ((global-inter-system-space
+	    (ly:output-def-lookup paper 'betweensystemspace))
+	   (top-space
+	    (ly:output-def-lookup paper 'pagetopspace))
+	   (global-fixed-dist (ly:output-def-lookup paper 'betweensystempadding))
+	   
+	   (system-vector (list->vector
+			   (append lines
+				   (if (= (length lines) 1)
+				       '(#f)
+				       '()))))
+	   (staff-extents
+	    (list->vector
+	     (append (map paper-system-staff-extents lines)
+		     (if (= (length lines) 1)
+			 '((0 . 0))
+			 '()))))
+
+	   (real-extents
+	    (list->vector
+	     (append
+	      (map
+	       (lambda (sys) (paper-system-extent sys Y)) lines)
+	      (if (= (length lines) 1)
+		  '((0 .  0))
+		  '()))))
+	   
+	   (system-count (vector-length real-extents))
+	   (topskip (max
+		     (+
+		      top-space
+		      (interval-end (vector-ref staff-extents 0)))
+		     (interval-end (vector-ref real-extents 0))
+		     ))
+	   (last-system (vector-ref system-vector (1- system-count)))
+	   (bottom-space (if (ly:paper-system? last-system)
+			     (ly:paper-system-property last-system 'bottom-space 0.0)
+			     0.0))
+	   (space-left (- page-height
+			  bottom-space
+			  (apply + (map interval-length
+					(vector->list real-extents)))))
+
+	   (space (- page-height
+		     topskip
+		     bottom-space
+		     (-  (interval-start
+			  (vector-ref real-extents (1- system-count))))))
+
+	   (calc-spring
+	    (lambda (idx)
+	      (let* (
+		     (upper-system (vector-ref system-vector idx))
+		     (between-space (ly:paper-system-property upper-system 'next-space
+							      global-inter-system-space))
+		     (fixed-dist (ly:paper-system-property upper-system 'next-padding
+							   global-fixed-dist))
+		     
+		     (this-system-ext (vector-ref staff-extents idx))
+		     (next-system-ext (vector-ref staff-extents (1+ idx)))
+		     (fixed (max 0 (- (+ (interval-end next-system-ext)
+					 fixed-dist)
+				      (interval-start this-system-ext))))
+		     (title1? (and (vector-ref system-vector idx)
+				   (paper-system-title? (vector-ref system-vector idx)
+							     )))
+		     (title2? (and
+			       (vector-ref system-vector (1+ idx))
+			       (paper-system-title? (vector-ref system-vector (1+ idx)))))
+		     (ideal (+
+			     (cond
+			      ((and title2? title1?)
+			       (ly:output-def-lookup paper 'betweentitlespace))
+			      (title1?
+			       (ly:output-def-lookup paper 'aftertitlespace))
+			      (title2?
+			       (ly:output-def-lookup paper 'beforetitlespace))
+			      (else between-space))
+			     fixed))
+		     (hooke (/ 1 (- ideal fixed))))
+		(list ideal hooke))))
+
+	   (springs (map calc-spring (iota (1- system-count))))
+	   (calc-rod
+	    (lambda (idx)
+	      (let* (
+		     (upper-system (vector-ref system-vector idx))
+		     (fixed-dist (ly:paper-system-property upper-system 'next-padding
+							   global-fixed-dist))
+		     (this-system-ext (vector-ref real-extents idx))
+		     (next-system-ext (vector-ref real-extents (1+ idx)))
+		     
+		     (distance (max  (- (+ (interval-end next-system-ext)
+					   fixed-dist)
+					(interval-start this-system-ext)
+					) 0))
+		     (entry (list idx (1+ idx) distance)))
+		entry)))
+	   (rods (map calc-rod (iota (1- system-count))))
+
+	   ;; we don't set ragged based on amount space left.
+	   ;; raggedbottomlast = ##T is much more predictable
+	   (result (ly:solve-spring-rod-problem
+		    springs rods space
+		    ragged?))
+
+	   (force (car result))
+	   (positions
+	    (map (lambda (y)
+		   (+ y topskip))
+		 (cdr  result))))
+
+      (if #f ;; debug.
+	  (begin
+	    (display (list "\n# systems: " system-count
+			   "\nreal-ext" real-extents "\nstaff-ext" staff-extents
+			   "\ninterscore" global-inter-system-space
+			   "\nspace-left" space-left
+			   "\nspring,rod" springs rods
+			   "\ntopskip " topskip
+			   " space " space
+			   "\npage-height" page-height
+			   "\nragged" ragged?
+			   "\nforce" force
+			   "\nres" (cdr result)
+			   "\npositions" positions "\n"))))
+
+      (cons force positions)))
+
+  (define (walk-paths done-lines best-paths current-lines  last? current-best)
+    "Return the best optimal-page-break-node that contains
+CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
+ascending range of lines, and BEST-PATHS contains the optimal breaks
+corresponding to DONE-LINES.
+
+CURRENT-BEST is the best result sofar, or #f."
+
+
+    (let* ((this-page-num (if (null? best-paths)
+                              (ly:output-def-lookup paper 'firstpagenumber)
+                              (1+ (node-page-number (car best-paths)))))
+
+	   (ragged-all? (eq? #t (ly:output-def-lookup paper 'raggedbottom)))
+	   (ragged-last? (eq? #t (ly:output-def-lookup paper 'raggedlastbottom)))
+	   (ragged? (or ragged-all?
+			(and ragged-last?
+			     last?)))
+           (page-height (page-height this-page-num last?))
+	   (vertical-spacing (space-systems page-height current-lines ragged?))
+	   (satisfied-constraints (car vertical-spacing))
+           (force (if satisfied-constraints
+		      (if (and last? ragged-last?)
+			  0.0
+			  satisfied-constraints)
+		      10000))
+	   (positions (cdr vertical-spacing))
+	   (get-break-penalty (lambda (sys)
+				(ly:paper-system-property sys 'penalty 0.0)))
+	   (user-nobreak-penalties
+	    (-
+	     (apply + (filter negative?
+			      (map get-break-penalty
+				   (cdr current-lines))))))
+           (user-penalty
+	    (+
+	     (max (get-break-penalty (car current-lines)) 0.0)
+	     user-nobreak-penalties))
+	   
+           (total-penalty (combine-penalties
+                           force user-penalty
+			   best-paths))
+
+           (better? (or
+                     (not current-best)
+                     (< total-penalty (node-penalty current-best))))
+           (new-best (if better?
+			 (make <optimally-broken-page-node>
+			   #:prev (if (null? best-paths)
+				      #f
+				      (car best-paths))
+			   #:lines current-lines
+			   #:pageno this-page-num
+			   #:force force
+			   #:configuration positions
+			   #:penalty total-penalty)
+                         current-best)))
+
+;;      (display total-penalty) (newline)
+      (if #f ;; debug
+          (display
+           (list
+            "\nuser pen " user-penalty
+	    "\nsatisfied-constraints" satisfied-constraints
+	    "\nlast? " last? "ragged?" ragged?
+            "\nbetter? " better? " total-penalty " total-penalty "\n"
+	    "\nconfig " positions
+            "\nforce " force
+	    "\nlines: " current-lines "\n")))
+
+      (if #f ; debug
+	  (display (list "\nnew-best is " (node-lines new-best)
+			 "\ncontinuation of "
+			 (if (null? best-paths)
+			     "start"
+			     (node-lines (car best-paths))))))
+
+      (if (and (pair? done-lines)
+               ;; if this page is too full, adding another line won't help
+               satisfied-constraints)
+          (walk-paths (cdr done-lines) (cdr best-paths)
+                      (cons (car done-lines) current-lines)
+                      last? new-best)
+	  new-best)))
+
+  (define (walk-lines done best-paths todo)
+    "Return the best page breaking as a single
+<optimal-page-break-node> for optimally breaking TODO ++
+DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
+DONE."
+    
+    (if (null? todo)
+	(car best-paths)
+	(let* ((this-line (car todo))
+	       (last? (null? (cdr todo)))
+	       (next (walk-paths done best-paths (list this-line) last? #f)))
+
+	  ;; (display "\n***************")
+	  (walk-lines (cons this-line done)
+		      (cons next best-paths)
+		      (cdr todo)))))
+
+  (define (line-number node)
+    (ly:paper-system-property (car (node-lines node)) 'number))
+
+  (ly:message (_ "Calculating page breaks..."))
+  (set! force-equalization-factor
+	(ly:output-def-lookup paper 'verticalequalizationfactor 0.3))
+
+  (let* ((best-break-node (walk-lines '() '() lines))
+	 (break-nodes (get-path best-break-node '()))
+	 (last-node (car (last-pair break-nodes))))
+
+    (define (node->page-stencil node)
+      (if (not (eq? node last-node))
+	  (ly:progress "["))
+      (let ((stencil
+	     ((ly:output-def-lookup paper 'page-make-stencil)
+	      (node-lines node)
+	      (node-configuration node)
+	      paper
+	      scopes
+	      (node-page-number node)
+	      (eq? node best-break-node))))
+	(if (not (eq? node last-node))
+	    (begin
+	      (ly:progress (number->string
+			    (car (last-pair (node-system-numbers node)))))
+	      (ly:progress "]")))
+	stencil))
+
+    (if #f; (ly:get-option 'verbose)
+	(begin
+	  (display (list
+		    "\nbreaks: " (map line-number break-nodes))
+		   "\nsystems " (map node-lines break-nodes)
+		   "\npenalties " (map node-penalty break-nodes)
+		   "\nconfigs " (map node-configuration break-nodes))))
+
+    (let ((stencils (map node->page-stencil break-nodes)))
+      (ly:progress "\n")
+      stencils)))
diff --git a/scm/layout-slur.scm b/scm/layout-slur.scm
new file mode 100644
index 0000000000..777b4a86dd
--- /dev/null
+++ b/scm/layout-slur.scm
@@ -0,0 +1,28 @@
+;;;; slur.scm -- Slur scheme stuff
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;; 
+;;;; (c) 2000--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+				;
+; this is put into the slur-details property of Slur and PhrasingSlur
+(define default-slur-details
+  '((region-size . 4)
+    (head-encompass-penalty . 1000.0)
+    (stem-encompass-penalty . 30.0)
+    (closeness-factor . 10)
+    (edge-attraction-factor . 4)
+    (same-slope-penalty . 20)
+    (steeper-slope-factor . 50)
+    (non-horizontal-penalty . 15)
+    (max-slope . 1.1)
+    (max-slope-factor . 10)
+    (free-head-distance . 0.3)
+    (free-slur-distance . 0.8)
+    (extra-object-collision . 50)
+    (accidental-collision . 3)
+    (extra-encompass-free-distance . 0.3)
+    (head-slur-distance-max-ratio . 3)
+    (head-slur-distance-factor . 10)
+    (absolute-closeness-measure . 0.3)
+    (edge-slope-exponent . 1.7)
+    ))
diff --git a/scm/lily.scm b/scm/lily.scm
index cc899a67b3..593daa2cac 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -224,7 +224,6 @@ The syntax is the same as `define*-public'."
 	    "chord-generic-names.scm"
 	    "stencil.scm"
 	    "markup.scm"
-	    "bass-figure.scm"
 	    "music-functions.scm"
 	    "part-combiner.scm"
 	    "autochange.scm"
@@ -232,15 +231,15 @@ The syntax is the same as `define*-public'."
 	    "auto-beam.scm"
 	    "chord-name.scm"
 
-	    "ly-from-scheme.scm"
+	    "parser-ly-from-scheme.scm"
 	    
 	    "define-context-properties.scm"
 	    "translation-functions.scm"
 	    "script.scm"
 	    "midi.scm"
-	    "beam.scm"
-	    "clef.scm"
-	    "slur.scm"
+	    "layout-beam.scm"
+	    "parser-clef.scm"
+	    "layout-slur.scm"
 	    "font.scm"
 	    "encoding.scm"
 	    
@@ -250,7 +249,7 @@ The syntax is the same as `define*-public'."
 	    "define-grobs.scm"
 	    "define-grob-interfaces.scm"
 	    "define-stencil-commands.scm"
-	    "page-layout.scm"
+	    "layout-page-layout.scm"
 	    "titling.scm"
 	    
 	    "paper.scm"
diff --git a/scm/ly-from-scheme.scm b/scm/ly-from-scheme.scm
deleted file mode 100644
index 79267499bd..0000000000
--- a/scm/ly-from-scheme.scm
+++ /dev/null
@@ -1,96 +0,0 @@
-;;;; ly-from-scheme.scm -- parsing LilyPond music expressions from scheme
-;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 2004--2005  Nicolas Sceaux  <nicolas.sceaux@free.fr>
-;;;;           Jan Nieuwenhuizen <janneke@gnu.org>
-
-(define gen-lily-sym
-  ;; Generate a lilyvartmpXX symbol, that may be (hopefully) unique.
-  (let ((var-idx -1))
-    (lambda ()
-      (set! var-idx (1+ var-idx))
-      (string->symbol (format #f "lilyvartmp~a"
-                              (list->string (map (lambda (chr)
-                                                   (integer->char (+ (char->integer #\a) (- (char->integer chr)
-                                                                                            (char->integer #\0)))))
-                                                 (string->list (number->string var-idx)))))))))
-
-(define-public (ly:parse-string-result str parser)
-  "Parse `str', which is supposed to contain a music expression."
-  (let ((music-sym (gen-lily-sym)))
-    (ly:parser-parse-string
-     parser
-     (format #f "parseStringResult = { ~a }" str))
-
-    (ly:parser-lookup parser 'parseStringResult)))
-
-(define-public (read-lily-expression chr port)
-  "Read a #{ lily music expression #} from port and return
-the scheme music expression. The $ character may be used to introduce
-scheme forms, typically symbols. $$ may be used to simply write a `$'
-character."
-  (let ((bindings '()))
-
-    (define (create-binding! val)
-      "Create a new symbol, bind it to `val' and return it."
-      (let ((tmp-symbol (gen-lily-sym)))
-
-        (set! bindings (cons (cons tmp-symbol val) bindings))
-        tmp-symbol))
-    
-    (define (remove-dollars! form)
-      "Generate a form where `$variable' and `$ value' mottos are replaced
-      by new symbols, which are binded to the adequate values."
-      (cond (;; $variable
-             (and (symbol? form)
-                  (string=? (substring (symbol->string form) 0 1) "$")
-                  (not (and (<= 2 (string-length (symbol->string form)))
-			    (string=? (substring (symbol->string form) 1 2) "$"))))
-             (create-binding! (string->symbol (substring (symbol->string form) 1))))
-            (;; atom
-             (not (pair? form)) form)
-            (;; ($ value ...)
-             (eqv? (car form) '$)
-             (cons (create-binding! (cadr form)) (remove-dollars! (cddr form))))
-            (else ;; (something ...)
-             (cons (remove-dollars! (car form)) (remove-dollars! (cdr form))))))
-    (let*
-	((lily-string (call-with-output-string
-                        (lambda (out)
-                          (do ((c (read-char port) (read-char port)))
-                             ((and (char=? c #\#)
-                                   (char=? (peek-char port) #\})) ;; we stop when #} is encoutered
-                              (read-char port))
-                           (cond
-                            ;; a $form expression
-                            ((and (char=? c #\$) (not (char=? (peek-char port) #\$)))
-                             (format out "\\~a" (create-binding! (read port))))
-                            ;; just a $ character
-                            ((and (char=? c #\$) (char=? (peek-char port) #\$))
-			     ;; pop the second $
-                             (display (read-char port) out))
-                            ;; a #scheme expression
-                            ((char=? c #\#)
-                             (let ((expr (read port)))
-                               (format out "#~s" (if (eq? '$ expr)
-                                                     (create-binding! (read port))
-                                                     (remove-dollars! expr)))))
-                            ;; other caracters
-                            (else
-                             (display c out)))))))
-
-	  (result
-	   `(let ((parser-clone (ly:clone-parser parser)))
-	      ,@(map (lambda (binding)
-		       `(ly:parser-define! parser-clone ',(car binding) ,(cdr binding)))
-		     (reverse bindings))
-	      (ly:parse-string-result ,lily-string parser-clone))
-	  ))
-
-      
-	     
-      result
-      )))
-
-(read-hash-extend #\{ read-lily-expression)
diff --git a/scm/page-layout.scm b/scm/page-layout.scm
deleted file mode 100644
index 64259c0263..0000000000
--- a/scm/page-layout.scm
+++ /dev/null
@@ -1,731 +0,0 @@
-;;;; page-layout.scm -- page breaking and page layout
-;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 2004--2005 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;;          Han-Wen Nienhuys <hanwen@cs.uu.nl>
-
-(use-modules (oop goops describe)
-	     (oop goops))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-class <optimally-broken-page-node> ()
-  (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev)
-  (page #:init-value 0 #:accessor node-page-number #:init-keyword #:pageno)
-  (force #:init-value 0 #:accessor node-force #:init-keyword #:force)
-  (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty)
-  (configuration #:init-value '() #:accessor node-configuration #:init-keyword #:configuration)
-  (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines))
-
-(define-method (display (node <optimally-broken-page-node>) port)
-  (map (lambda (x) (display x port))
-       (list
-	"Page " (node-page-number node)
-	" Lines: " (node-lines node)
-	" Penalty " (node-penalty node)
-	"\n")))
-
-(define-method (node-system-numbers (node <optimally-broken-page-node>))
-  (map (lambda (ps) (ly:paper-system-property ps 'number))
-       (node-lines node)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (annotate? layout)
-  (eq? #t (ly:output-def-lookup layout 'annotatespacing)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-public (paper-system-staff-extents ps)
-  (ly:paper-system-property ps 'refpoint-Y-extent '(0 . 0)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ANNOTATIONS
-;;
-;; annotations are arrows indicating the numerical value of
-;; spacing variables 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (annotate-y-interval layout name extent is-length?)
-  ;; do something sensible for 0,0 intervals. 
-  (set! extent (interval-widen extent 0.001))
-  (let*
-      ((text-props (cons
-		    '((font-size . -3)
-		      (font-family . typewriter))
-		    (layout-extract-page-properties layout)))
-       (annotation (interpret-markup
-		    layout text-props
-		    (make-column-markup
-		     (list
-		      (make-whiteout-markup (make-simple-markup name))
-		      (make-whiteout-markup
-		       (make-simple-markup
-			(if is-length?
-			    (format "~$" (interval-length extent))
-			    (format "(~$,~$)" (car extent)
-				    (cdr extent)))))))))
-       (arrows
-	(ly:stencil-translate-axis 
-	 (dimension-arrows (cons 0 (interval-length extent)))
-	 (interval-start extent) Y)))
-
-    (set! annotation
-	  (ly:stencil-aligned-to annotation Y CENTER))
-    
-    (set! annotation (ly:stencil-translate annotation
-			  (cons 0 (interval-center extent))))
-
-    (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5 0)
-    ))
-
-(define (paper-system-annotate-last system layout)
-  (let*
-      ((bottomspace (ly:paper-system-property system 'bottom-space))
-       (y-extent (paper-system-extent system Y))
-       (x-extent (paper-system-extent system X))
-       (stencil (ly:paper-system-property system 'stencil))
-     
-       (arrow (if (number? bottomspace)
-	       (annotate-y-interval layout
-				    "bottom-space"
-				    (cons (- (car y-extent) bottomspace)
-					  (car y-extent))
-				    #t)
-	       #f)))
-    
-    (if arrow
-	(set! stencil
-	      (ly:stencil-add stencil arrow)))
-
-    (set! (ly:paper-system-property system 'stencil)
-	  stencil)
-  ))
-  
-(define (paper-system-annotate system layout)
-  "Add arrows and texts to indicate which lengths are set."
-  (let*
-      ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
-       (append-stencil
-	(lambda (a b)
-	  (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
-
-       (annotate-property
-	(lambda (name extent is-length?)
-	  (set! annotations
-		(append-stencil annotations
-				(annotate-y-interval layout
-						     name extent is-length?)))))
-
-       (bbox-extent (paper-system-extent system Y))
-       (refp-extent (ly:paper-system-property system 'refpoint-Y-extent))
-       (next-space (ly:paper-system-property system 'next-space
-					     (ly:output-def-lookup layout 'betweensystemspace)
-					     ))
-       (next-padding (ly:paper-system-property system 'next-padding
-					       (ly:output-def-lookup layout 'betweensystempadding)
-					       ))
-		     
-       )
-
-    (if (number-pair? bbox-extent)
-	(begin
-	  (annotate-property  "Y-extent"
-			       bbox-extent #f)
-	  (annotate-property  "next-padding"
-			     (interval-translate (cons (- next-padding) 0) (car bbox-extent))
-			     #t)))
-    
-    ;; titles don't have a refpoint-Y-extent.
-    (if (number-pair? refp-extent)
-	(begin
-	  (annotate-property "refpoint-Y-extent"
-			     refp-extent #f)
-	
-	  (annotate-property "next-space"
-			     (interval-translate (cons (- next-space) 0) (car refp-extent))
-		       #t)))
-	
-    
-
-    (set! (ly:paper-system-property system 'stencil)
-	  (ly:stencil-add
-	   (ly:paper-system-property system 'stencil)
-	   (ly:make-stencil
-	    (ly:stencil-expr annotations)
-	    (ly:stencil-extent empty-stencil X)
-	    (ly:stencil-extent empty-stencil Y)
-	    )))
-    
-    ))
-
-(define (annotate-page layout stencil)
-  (let*
-      ((topmargin (ly:output-def-lookup layout 'topmargin))
-       (vsize (ly:output-def-lookup layout 'vsize))
-       (bottommargin (ly:output-def-lookup layout 'bottommargin))
-       (add-stencil (lambda (y)
-		      (set! stencil
-			    (ly:stencil-add stencil y))
-		      )))
-
-    (add-stencil
-     (ly:stencil-translate-axis 
-      (annotate-y-interval layout "vsize"
-			   (cons (- vsize) 0)
-			   #t)
-      1 X))
-    
-    (add-stencil
-     (ly:stencil-translate-axis 
-      (annotate-y-interval layout "topmargin"
-			   (cons (- topmargin) 0)
-			   #t)
-      2 X))
-    
-    (add-stencil
-     (ly:stencil-translate-axis 
-      (annotate-y-interval layout "bottommargin"
-			   (cons (- vsize) (- bottommargin vsize))
-			   #t)
-      2 X))
-    
-    stencil))
-
-(define (annotate-space-left page-stencil layout bottom-edge)
-  (let*
-      ((arrow (annotate-y-interval layout
-				"space left"
-				(cons (- bottom-edge)  (car (ly:stencil-extent page-stencil Y)))
-				#t)))
-    
-    (set! arrow (ly:stencil-translate-axis arrow 8 X))
-    (ly:stencil-add page-stencil arrow)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(define (page-headfoot layout scopes number
-		       sym separation-symbol dir last?)
-  "Create a stencil including separating space."
-
-  (let* ((header-proc (ly:output-def-lookup layout sym))
-	 (sep (ly:output-def-lookup layout separation-symbol))
-	 (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
-	 (head-stencil
-	  (if (procedure? header-proc)
-	      (header-proc layout scopes number last?)
-	      #f))
-	 )
-    
-    (if (and (number? sep)
-	     (ly:stencil? head-stencil)
-	     (not (ly:stencil-empty? head-stencil)))
-
-	(begin
-	  (set! head-stencil
-		(ly:stencil-combine-at-edge
-		 stencil Y dir head-stencil
-		 sep 0.0))
-
-	  
-	  ;; add arrow markers 
-	  (if (annotate? layout)
-	      (set! head-stencil
-		    (ly:stencil-add
-		     (ly:stencil-translate-axis
-		      (annotate-y-interval layout 
-					   (symbol->string separation-symbol)
-					   (cons (min 0 (* dir sep))
-						 (max 0 (* dir sep)))
-					   #t)
-		      (/ (ly:output-def-lookup layout 'linewidth) 2)
-		      X)
-		     head-stencil
-		     ))
-	      )))
-
-    head-stencil))
-
-(define-public (default-page-music-height layout scopes number last?)
-  "Printable area for music and titles; matches default-page-make-stencil."
-  (let* ((h (- (ly:output-def-lookup layout 'vsize)
-	       (ly:output-def-lookup layout 'topmargin)
-	       (ly:output-def-lookup layout 'bottommargin)))
-	 
-       (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
-       (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
-       (available
-	(- h (if (ly:stencil? head)
-		 (interval-length (ly:stencil-extent head Y))
-		 0)
-	   (if (ly:stencil? foot)
-	       (interval-length (ly:stencil-extent foot Y))
-	       0))))
-
-    ;; (display (list "\n available" available head foot))
-    available))
-
-(define-public (default-page-make-stencil
-		 lines offsets layout scopes number last?)
-  "Construct a stencil representing the page from LINES.
-
- Offsets is a list of increasing numbers. They must be negated to
-create offsets.
- "
-
-  (let* ((topmargin (ly:output-def-lookup layout 'topmargin))
-
-       ;; TODO: naming vsize/hsize not analogous to TeX.
-
-	 (vsize (ly:output-def-lookup layout 'vsize))
-	 (hsize (ly:output-def-lookup layout 'hsize))
-	 
-	 (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0))
-	 (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
-	 (system-separator-stencil (if (markup? system-separator-markup)
-				       (interpret-markup layout
-							 (layout-extract-page-properties layout)
-							 system-separator-markup)
-				       #f))
-	 (lmargin (ly:output-def-lookup layout 'leftmargin))
-	 (leftmargin (if lmargin
-			 lmargin
-			 (/ (- hsize
-			       (ly:output-def-lookup layout 'linewidth)) 2)))
-
-	 (rightmargin (ly:output-def-lookup layout 'rightmargin))
-	 (bottom-edge (- vsize
-			 (ly:output-def-lookup layout 'bottommargin)))
-
-	 (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
-	 (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
-
-	 (head-height (if (ly:stencil? head)
-			  (interval-length (ly:stencil-extent head Y))
-			  0.0))
-
-	 (height-proc (ly:output-def-lookup layout 'page-music-height))
-
-	 (page-stencil (ly:make-stencil '()
-					(cons leftmargin hsize)
-					(cons (- topmargin) 0)))
-	 (last-system #f)
-	 (last-y 0.0)
-	 (add-to-page (lambda (stencil y)
-			(set! page-stencil
-			      (ly:stencil-add page-stencil
-					      (ly:stencil-translate stencil
-								    (cons
-								     system-xoffset
-								     (- 0 head-height y topmargin))
-
-								    )))))
-	 (add-system
-	  (lambda (stencil-position)
-	    (let* ((system (car stencil-position))
-		   (stencil (paper-system-stencil system))
-		   (y (cadr stencil-position))
-		   (is-title (paper-system-title?
-			      (car stencil-position))))
-	      (add-to-page stencil y)
-	      (if (and (ly:stencil? system-separator-stencil)
-		       last-system
-		       (not (paper-system-title? system))
-		       (not (paper-system-title? last-system)))
-		  (add-to-page
-		   system-separator-stencil
-		   (average (- last-y
-			       (car (paper-system-staff-extents last-system)))
-			    (- y
-			       (cdr (paper-system-staff-extents system))))))
-	      (set! last-system system)
-	      (set! last-y y))))
-	 )
-
-
-    (if (annotate? layout)
-	(begin
-	  (for-each (lambda (sys) (paper-system-annotate sys layout))
-		    lines)
-	  (paper-system-annotate-last (car (last-pair lines)) layout)))
-  
-    
-    (if #f
-	(display (list
-		  "leftmargin " leftmargin "rightmargin " rightmargin
-		  )))
-
-    (set! page-stencil (ly:stencil-combine-at-edge
-			page-stencil Y DOWN
-			(if (and
-			     (ly:stencil? head)
-			     (not (ly:stencil-empty? head)))
-			    head
-			    (ly:make-stencil "" (cons 0 0) (cons 0 0)))
-			    0. 0.))
-
-    (map add-system (zip lines offsets))
-
-    (if (annotate? layout)
-	(set!
-	 page-stencil
-	 (annotate-space-left page-stencil layout
-			      (- bottom-edge
-				 (if (ly:stencil? foot)
-				     (interval-length (ly:stencil-extent foot Y))
-				     0)))
-	 ))
-
-    
-    (if (and (ly:stencil? foot)
-	     (not (ly:stencil-empty? foot)))
-	(set! page-stencil
-	      (ly:stencil-add
-	       page-stencil
-	       (ly:stencil-translate
-		foot
-		(cons 0
-		      (+ (- bottom-edge)
-			 (- (car (ly:stencil-extent foot Y)))))))))
-
-    (set! page-stencil
-	  (ly:stencil-translate page-stencil (cons leftmargin 0)))
-
-    ;; annotation.
-    (if (annotate? layout)
-	(set! page-stencil (annotate-page layout page-stencil)))
-    
-
-    page-stencil))
-
-;;; optimal page breaking
-
-;;; This is not optimal page breaking, this is optimal distribution of
-;;; lines over pages; line breaks are a given.
-
-;; TODO:
-;;
-;; - density scoring
-;; - separate function for word-wrap style breaking?
-;; - raggedbottom? raggedlastbottom?
-
-(define-public (optimal-page-breaks lines paper-book)
-  "Return pages as a list starting with 1st page. Each page is a list
-of lines. "
-
-  (define MAXPENALTY 1e9)
-  (define paper (ly:paper-book-paper paper-book))
-  (define scopes (ly:paper-book-scopes paper-book))
-  (define force-equalization-factor #f)
-
-  (define (page-height page-number last?)
-    (let ((p (ly:output-def-lookup paper 'page-music-height)))
-
-      (if (procedure? p)
-	  (p paper scopes page-number last?)
-	  10000)))
-
-  (define (get-path node done)
-    "Follow NODE.PREV, and return as an ascending list of pages. DONE
-is what have collected so far, and has ascending page numbers."
-
-    (if (is-a? node <optimally-broken-page-node>)
-	(get-path (node-prev node) (cons node done))
-	done))
-
-  (define (combine-penalties force user best-paths)
-    (let* ((prev-force (if (null? best-paths)
-			   0.0
-			   (node-force (car best-paths))))
-	   (prev-penalty (if (null? best-paths)
-			     0.0
-			     (node-penalty (car best-paths))))
-	 (inter-system-space (ly:output-def-lookup paper 'betweensystemspace))
-	 (relative-force (/ force inter-system-space))
-	 (abs-relative-force (abs relative-force)))
-
-
-      (+ (* abs-relative-force (+ abs-relative-force 1))
-	 prev-penalty
-	 (* force-equalization-factor (/ (abs (- prev-force force))
-					 inter-system-space))
-	 user)))
-
-  (define (space-systems page-height lines ragged?)
-    (let* ((global-inter-system-space
-	    (ly:output-def-lookup paper 'betweensystemspace))
-	   (top-space
-	    (ly:output-def-lookup paper 'pagetopspace))
-	   (global-fixed-dist (ly:output-def-lookup paper 'betweensystempadding))
-	   
-	   (system-vector (list->vector
-			   (append lines
-				   (if (= (length lines) 1)
-				       '(#f)
-				       '()))))
-	   (staff-extents
-	    (list->vector
-	     (append (map paper-system-staff-extents lines)
-		     (if (= (length lines) 1)
-			 '((0 . 0))
-			 '()))))
-
-	   (real-extents
-	    (list->vector
-	     (append
-	      (map
-	       (lambda (sys) (paper-system-extent sys Y)) lines)
-	      (if (= (length lines) 1)
-		  '((0 .  0))
-		  '()))))
-	   
-	   (system-count (vector-length real-extents))
-	   (topskip (max
-		     (+
-		      top-space
-		      (interval-end (vector-ref staff-extents 0)))
-		     (interval-end (vector-ref real-extents 0))
-		     ))
-	   (last-system (vector-ref system-vector (1- system-count)))
-	   (bottom-space (if (ly:paper-system? last-system)
-			     (ly:paper-system-property last-system 'bottom-space 0.0)
-			     0.0))
-	   (space-left (- page-height
-			  bottom-space
-			  (apply + (map interval-length
-					(vector->list real-extents)))))
-
-	   (space (- page-height
-		     topskip
-		     bottom-space
-		     (-  (interval-start
-			  (vector-ref real-extents (1- system-count))))))
-
-	   (calc-spring
-	    (lambda (idx)
-	      (let* (
-		     (upper-system (vector-ref system-vector idx))
-		     (between-space (ly:paper-system-property upper-system 'next-space
-							      global-inter-system-space))
-		     (fixed-dist (ly:paper-system-property upper-system 'next-padding
-							   global-fixed-dist))
-		     
-		     (this-system-ext (vector-ref staff-extents idx))
-		     (next-system-ext (vector-ref staff-extents (1+ idx)))
-		     (fixed (max 0 (- (+ (interval-end next-system-ext)
-					 fixed-dist)
-				      (interval-start this-system-ext))))
-		     (title1? (and (vector-ref system-vector idx)
-				   (paper-system-title? (vector-ref system-vector idx)
-							     )))
-		     (title2? (and
-			       (vector-ref system-vector (1+ idx))
-			       (paper-system-title? (vector-ref system-vector (1+ idx)))))
-		     (ideal (+
-			     (cond
-			      ((and title2? title1?)
-			       (ly:output-def-lookup paper 'betweentitlespace))
-			      (title1?
-			       (ly:output-def-lookup paper 'aftertitlespace))
-			      (title2?
-			       (ly:output-def-lookup paper 'beforetitlespace))
-			      (else between-space))
-			     fixed))
-		     (hooke (/ 1 (- ideal fixed))))
-		(list ideal hooke))))
-
-	   (springs (map calc-spring (iota (1- system-count))))
-	   (calc-rod
-	    (lambda (idx)
-	      (let* (
-		     (upper-system (vector-ref system-vector idx))
-		     (fixed-dist (ly:paper-system-property upper-system 'next-padding
-							   global-fixed-dist))
-		     (this-system-ext (vector-ref real-extents idx))
-		     (next-system-ext (vector-ref real-extents (1+ idx)))
-		     
-		     (distance (max  (- (+ (interval-end next-system-ext)
-					   fixed-dist)
-					(interval-start this-system-ext)
-					) 0))
-		     (entry (list idx (1+ idx) distance)))
-		entry)))
-	   (rods (map calc-rod (iota (1- system-count))))
-
-	   ;; we don't set ragged based on amount space left.
-	   ;; raggedbottomlast = ##T is much more predictable
-	   (result (ly:solve-spring-rod-problem
-		    springs rods space
-		    ragged?))
-
-	   (force (car result))
-	   (positions
-	    (map (lambda (y)
-		   (+ y topskip))
-		 (cdr  result))))
-
-      (if #f ;; debug.
-	  (begin
-	    (display (list "\n# systems: " system-count
-			   "\nreal-ext" real-extents "\nstaff-ext" staff-extents
-			   "\ninterscore" global-inter-system-space
-			   "\nspace-left" space-left
-			   "\nspring,rod" springs rods
-			   "\ntopskip " topskip
-			   " space " space
-			   "\npage-height" page-height
-			   "\nragged" ragged?
-			   "\nforce" force
-			   "\nres" (cdr result)
-			   "\npositions" positions "\n"))))
-
-      (cons force positions)))
-
-  (define (walk-paths done-lines best-paths current-lines  last? current-best)
-    "Return the best optimal-page-break-node that contains
-CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
-ascending range of lines, and BEST-PATHS contains the optimal breaks
-corresponding to DONE-LINES.
-
-CURRENT-BEST is the best result sofar, or #f."
-
-
-    (let* ((this-page-num (if (null? best-paths)
-                              (ly:output-def-lookup paper 'firstpagenumber)
-                              (1+ (node-page-number (car best-paths)))))
-
-	   (ragged-all? (eq? #t (ly:output-def-lookup paper 'raggedbottom)))
-	   (ragged-last? (eq? #t (ly:output-def-lookup paper 'raggedlastbottom)))
-	   (ragged? (or ragged-all?
-			(and ragged-last?
-			     last?)))
-           (page-height (page-height this-page-num last?))
-	   (vertical-spacing (space-systems page-height current-lines ragged?))
-	   (satisfied-constraints (car vertical-spacing))
-           (force (if satisfied-constraints
-		      (if (and last? ragged-last?)
-			  0.0
-			  satisfied-constraints)
-		      10000))
-	   (positions (cdr vertical-spacing))
-	   (get-break-penalty (lambda (sys)
-				(ly:paper-system-property sys 'penalty 0.0)))
-	   (user-nobreak-penalties
-	    (-
-	     (apply + (filter negative?
-			      (map get-break-penalty
-				   (cdr current-lines))))))
-           (user-penalty
-	    (+
-	     (max (get-break-penalty (car current-lines)) 0.0)
-	     user-nobreak-penalties))
-	   
-           (total-penalty (combine-penalties
-                           force user-penalty
-			   best-paths))
-
-           (better? (or
-                     (not current-best)
-                     (< total-penalty (node-penalty current-best))))
-           (new-best (if better?
-			 (make <optimally-broken-page-node>
-			   #:prev (if (null? best-paths)
-				      #f
-				      (car best-paths))
-			   #:lines current-lines
-			   #:pageno this-page-num
-			   #:force force
-			   #:configuration positions
-			   #:penalty total-penalty)
-                         current-best)))
-
-;;      (display total-penalty) (newline)
-      (if #f ;; debug
-          (display
-           (list
-            "\nuser pen " user-penalty
-	    "\nsatisfied-constraints" satisfied-constraints
-	    "\nlast? " last? "ragged?" ragged?
-            "\nbetter? " better? " total-penalty " total-penalty "\n"
-	    "\nconfig " positions
-            "\nforce " force
-	    "\nlines: " current-lines "\n")))
-
-      (if #f ; debug
-	  (display (list "\nnew-best is " (node-lines new-best)
-			 "\ncontinuation of "
-			 (if (null? best-paths)
-			     "start"
-			     (node-lines (car best-paths))))))
-
-      (if (and (pair? done-lines)
-               ;; if this page is too full, adding another line won't help
-               satisfied-constraints)
-          (walk-paths (cdr done-lines) (cdr best-paths)
-                      (cons (car done-lines) current-lines)
-                      last? new-best)
-	  new-best)))
-
-  (define (walk-lines done best-paths todo)
-    "Return the best page breaking as a single
-<optimal-page-break-node> for optimally breaking TODO ++
-DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
-DONE."
-    
-    (if (null? todo)
-	(car best-paths)
-	(let* ((this-line (car todo))
-	       (last? (null? (cdr todo)))
-	       (next (walk-paths done best-paths (list this-line) last? #f)))
-
-	  ;; (display "\n***************")
-	  (walk-lines (cons this-line done)
-		      (cons next best-paths)
-		      (cdr todo)))))
-
-  (define (line-number node)
-    (ly:paper-system-property (car (node-lines node)) 'number))
-
-  (ly:message (_ "Calculating page breaks..."))
-  (set! force-equalization-factor
-	(ly:output-def-lookup paper 'verticalequalizationfactor 0.3))
-
-  (let* ((best-break-node (walk-lines '() '() lines))
-	 (break-nodes (get-path best-break-node '()))
-	 (last-node (car (last-pair break-nodes))))
-
-    (define (node->page-stencil node)
-      (if (not (eq? node last-node))
-	  (ly:progress "["))
-      (let ((stencil
-	     ((ly:output-def-lookup paper 'page-make-stencil)
-	      (node-lines node)
-	      (node-configuration node)
-	      paper
-	      scopes
-	      (node-page-number node)
-	      (eq? node best-break-node))))
-	(if (not (eq? node last-node))
-	    (begin
-	      (ly:progress (number->string
-			    (car (last-pair (node-system-numbers node)))))
-	      (ly:progress "]")))
-	stencil))
-
-    (if #f; (ly:get-option 'verbose)
-	(begin
-	  (display (list
-		    "\nbreaks: " (map line-number break-nodes))
-		   "\nsystems " (map node-lines break-nodes)
-		   "\npenalties " (map node-penalty break-nodes)
-		   "\nconfigs " (map node-configuration break-nodes))))
-
-    (let ((stencils (map node->page-stencil break-nodes)))
-      (ly:progress "\n")
-      stencils)))
diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm
new file mode 100644
index 0000000000..aeb34db579
--- /dev/null
+++ b/scm/parser-clef.scm
@@ -0,0 +1,127 @@
+;;;; clef.scm -- Clef settings
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2004--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+
+;; (name . (glyph clef-position octavation))
+;;
+;; -- the name clefOctavation is misleading. The value 7 is 1 octave,
+;; not 7 Octaves.
+(define-public supported-clefs
+  '(("treble" . ("clefs.G" -2 0))
+    ("violin" . ("clefs.G" -2 0))
+    ("G" . ("clefs.G" -2 0))
+    ("G2" . ("clefs.G" -2 0))
+    ("french" . ("clefs.G" -4 0))
+    ("soprano" . ("clefs.C" -4 0))
+    ("mezzosoprano" . ("clefs.C" -2 0))
+    ("alto" . ("clefs.C" 0 0))
+    ("C" . ("clefs.C" 0 0))
+    ("tenor" . ("clefs.C" 2 0))
+    ("baritone" . ("clefs.C" 4 0))
+    ("varbaritone" . ("clefs.F" 0 0))
+    ("bass" . ("clefs.F" 2 0))
+    ("F" . ("clefs.F" 2 0))
+    ("subbass" . ("clefs.F" 4 0))
+    ("percussion" . ("clefs.percussion" 0 0))
+    ("tab" . ("clefs.tab" 0 0))
+
+    ;; should move mensural stuff to separate file?
+    ("vaticana-do1" . ("clefs.vaticana.do" -1 0))
+    ("vaticana-do2" . ("clefs.vaticana.do" 1 0))
+    ("vaticana-do3" . ("clefs.vaticana.do" 3 0))
+    ("vaticana-fa1" . ("clefs.vaticana.fa" -1 0))
+    ("vaticana-fa2" . ("clefs.vaticana.fa" 1 0))
+    ("medicaea-do1" . ("clefs.medicaea.do" -1 0))
+    ("medicaea-do2" . ("clefs.medicaea.do" 1 0))
+    ("medicaea-do3" . ("clefs.medicaea.do" 3 0))
+    ("medicaea-fa1" . ("clefs.medicaea.fa" -1 0))
+    ("medicaea-fa2" . ("clefs.medicaea.fa" 1 0))
+    ("hufnagel-do1" . ("clefs.hufnagel.do" -1 0))
+    ("hufnagel-do2" . ("clefs.hufnagel.do" 1 0))
+    ("hufnagel-do3" . ("clefs.hufnagel.do" 3 0))
+    ("hufnagel-fa1" . ("clefs.hufnagel.fa" -1 0))
+    ("hufnagel-fa2" . ("clefs.hufnagel.fa" 1 0))
+    ("hufnagel-do-fa" . ("clefs.hufnagel.do.fa" 4 0))
+    ("mensural-c1" . ("clefs.mensural.c" -2 0))
+    ("mensural-c2" . ("clefs.mensural.c" 0 0))
+    ("mensural-c3" . ("clefs.mensural.c" 2 0))
+    ("mensural-c4" . ("clefs.mensural.c" 4 0))
+    ("mensural-f" . ("clefs.mensural.f" 2 0))
+    ("mensural-g" . ("clefs.mensural.g" -2 0))
+    ("neomensural-c1" . ("clefs.neomensural.c" -4 0))
+    ("neomensural-c2" . ("clefs.neomensural.c" -2 0))
+    ("neomensural-c3" . ("clefs.neomensural.c" 0 0))
+    ("neomensural-c4" . ("clefs.neomensural.c" 2 0))
+    ("petrucci-c1" . ("clefs.petrucci.c1" -4 0))
+    ("petrucci-c2" . ("clefs.petrucci.c2" -2 0))
+    ("petrucci-c3" . ("clefs.petrucci.c3" 0 0))
+    ("petrucci-c4" . ("clefs.petrucci.c4" 2 0))
+    ("petrucci-c5" . ("clefs.petrucci.c5" 4 0))
+    ("petrucci-f" . ("clefs.petrucci.f" 2 0))
+    ("petrucci-g" . ("clefs.petrucci.g" -2 0))))
+
+;; "an alist mapping GLYPHNAME to the position of the middle C for
+;; that symbol"
+(define c0-pitch-alist
+  '(("clefs.G" . -4)
+    ("clefs.C" . 0)
+    ("clefs.F" . 4)
+    ("clefs.percussion" . 0)
+    ("clefs.tab" . 0 )
+    ("clefs.vaticana.do" . 0)
+    ("clefs.vaticana.fa" . 4)
+    ("clefs.medicaea.do" . 0)
+    ("clefs.medicaea.fa" . 4)
+    ("clefs.hufnagel.do" . 0)
+    ("clefs.hufnagel.fa" . 4)
+    ("clefs.hufnagel.do.fa" . 0)
+    ("clefs.mensural.c" . 0)
+    ("clefs.mensural.f" . 4)
+    ("clefs.mensural.g" . -4)
+    ("clefs.neomensural.c" . 0)
+    ("clefs.petrucci.c1" . 0)
+    ("clefs.petrucci.c2" . 0)
+    ("clefs.petrucci.c3" . 0)
+    ("clefs.petrucci.c4" . 0)
+    ("clefs.petrucci.c5" . 0)
+    ("clefs.petrucci.f" . 4)
+    ("clefs.petrucci.g" . -4)))
+
+(define-public (make-clef-set clef-name)
+  "Generate the clef setting commands for a clef with name CLEF-NAME."
+  (define (make-prop-set props)
+    (let ((m (make-music 'PropertySet)))
+      (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
+      m))
+  (let ((e '())
+	(c0 0)
+	(oct 0)
+	(match (string-match "^(.*)([_^])([0-9]+)$" clef-name)))
+    (if match
+	(begin
+	  (set! clef-name (match:substring match 1))
+	  (set! oct
+		(* (if (equal? (match:substring match 2) "^") -1 1)
+		   (- (string->number (match:substring match 3)) 1)))))
+    (set! e (assoc clef-name supported-clefs))
+    (if (pair? e)
+	(let* ((musics (map make-prop-set
+			    `(((symbol . clefGlyph) (value . ,(cadr e)))
+			      ((symbol . middleCPosition)
+			       (value . ,(+ oct
+					    (caddr e)
+					    (cdr (assoc (cadr e) c0-pitch-alist)))))
+			      ((symbol . clefPosition) (value . ,(caddr e)))
+			      ((symbol . clefOctavation) (value . ,(- oct))))))
+	       (seq (make-music 'SequentialMusic
+				'elements musics))
+	       (csp (make-music 'ContextSpeccedMusic)))
+	  (context-spec-music seq 'Staff))
+	(begin
+	  (ly:warning (_ "unknown clef type `~a'") clef-name)
+	  (ly:warning (_ "see scm/clef.scm for supported clefs"))
+	  (make-music 'Music)))))
+
diff --git a/scm/parser-ly-from-scheme.scm b/scm/parser-ly-from-scheme.scm
new file mode 100644
index 0000000000..79267499bd
--- /dev/null
+++ b/scm/parser-ly-from-scheme.scm
@@ -0,0 +1,96 @@
+;;;; ly-from-scheme.scm -- parsing LilyPond music expressions from scheme
+;;;;
+;;;;  source file of the GNU LilyPond music typesetter
+;;;; 
+;;;; (c) 2004--2005  Nicolas Sceaux  <nicolas.sceaux@free.fr>
+;;;;           Jan Nieuwenhuizen <janneke@gnu.org>
+
+(define gen-lily-sym
+  ;; Generate a lilyvartmpXX symbol, that may be (hopefully) unique.
+  (let ((var-idx -1))
+    (lambda ()
+      (set! var-idx (1+ var-idx))
+      (string->symbol (format #f "lilyvartmp~a"
+                              (list->string (map (lambda (chr)
+                                                   (integer->char (+ (char->integer #\a) (- (char->integer chr)
+                                                                                            (char->integer #\0)))))
+                                                 (string->list (number->string var-idx)))))))))
+
+(define-public (ly:parse-string-result str parser)
+  "Parse `str', which is supposed to contain a music expression."
+  (let ((music-sym (gen-lily-sym)))
+    (ly:parser-parse-string
+     parser
+     (format #f "parseStringResult = { ~a }" str))
+
+    (ly:parser-lookup parser 'parseStringResult)))
+
+(define-public (read-lily-expression chr port)
+  "Read a #{ lily music expression #} from port and return
+the scheme music expression. The $ character may be used to introduce
+scheme forms, typically symbols. $$ may be used to simply write a `$'
+character."
+  (let ((bindings '()))
+
+    (define (create-binding! val)
+      "Create a new symbol, bind it to `val' and return it."
+      (let ((tmp-symbol (gen-lily-sym)))
+
+        (set! bindings (cons (cons tmp-symbol val) bindings))
+        tmp-symbol))
+    
+    (define (remove-dollars! form)
+      "Generate a form where `$variable' and `$ value' mottos are replaced
+      by new symbols, which are binded to the adequate values."
+      (cond (;; $variable
+             (and (symbol? form)
+                  (string=? (substring (symbol->string form) 0 1) "$")
+                  (not (and (<= 2 (string-length (symbol->string form)))
+			    (string=? (substring (symbol->string form) 1 2) "$"))))
+             (create-binding! (string->symbol (substring (symbol->string form) 1))))
+            (;; atom
+             (not (pair? form)) form)
+            (;; ($ value ...)
+             (eqv? (car form) '$)
+             (cons (create-binding! (cadr form)) (remove-dollars! (cddr form))))
+            (else ;; (something ...)
+             (cons (remove-dollars! (car form)) (remove-dollars! (cdr form))))))
+    (let*
+	((lily-string (call-with-output-string
+                        (lambda (out)
+                          (do ((c (read-char port) (read-char port)))
+                             ((and (char=? c #\#)
+                                   (char=? (peek-char port) #\})) ;; we stop when #} is encoutered
+                              (read-char port))
+                           (cond
+                            ;; a $form expression
+                            ((and (char=? c #\$) (not (char=? (peek-char port) #\$)))
+                             (format out "\\~a" (create-binding! (read port))))
+                            ;; just a $ character
+                            ((and (char=? c #\$) (char=? (peek-char port) #\$))
+			     ;; pop the second $
+                             (display (read-char port) out))
+                            ;; a #scheme expression
+                            ((char=? c #\#)
+                             (let ((expr (read port)))
+                               (format out "#~s" (if (eq? '$ expr)
+                                                     (create-binding! (read port))
+                                                     (remove-dollars! expr)))))
+                            ;; other caracters
+                            (else
+                             (display c out)))))))
+
+	  (result
+	   `(let ((parser-clone (ly:clone-parser parser)))
+	      ,@(map (lambda (binding)
+		       `(ly:parser-define! parser-clone ',(car binding) ,(cdr binding)))
+		     (reverse bindings))
+	      (ly:parse-string-result ,lily-string parser-clone))
+	  ))
+
+      
+	     
+      result
+      )))
+
+(read-hash-extend #\{ read-lily-expression)
diff --git a/scm/slur.scm b/scm/slur.scm
deleted file mode 100644
index 777b4a86dd..0000000000
--- a/scm/slur.scm
+++ /dev/null
@@ -1,28 +0,0 @@
-;;;; slur.scm -- Slur scheme stuff
-;;;;
-;;;; source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 2000--2005 Jan Nieuwenhuizen <janneke@gnu.org>
-				;
-; this is put into the slur-details property of Slur and PhrasingSlur
-(define default-slur-details
-  '((region-size . 4)
-    (head-encompass-penalty . 1000.0)
-    (stem-encompass-penalty . 30.0)
-    (closeness-factor . 10)
-    (edge-attraction-factor . 4)
-    (same-slope-penalty . 20)
-    (steeper-slope-factor . 50)
-    (non-horizontal-penalty . 15)
-    (max-slope . 1.1)
-    (max-slope-factor . 10)
-    (free-head-distance . 0.3)
-    (free-slur-distance . 0.8)
-    (extra-object-collision . 50)
-    (accidental-collision . 3)
-    (extra-encompass-free-distance . 0.3)
-    (head-slur-distance-max-ratio . 3)
-    (head-slur-distance-factor . 10)
-    (absolute-closeness-measure . 0.3)
-    (edge-slope-exponent . 1.7)
-    ))
diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm
index 571e6c964c..5c8fe4bf0b 100644
--- a/scm/translation-functions.scm
+++ b/scm/translation-functions.scm
@@ -52,3 +52,54 @@
 (define-public (format-mark-box-barnumbers mark context)
   (make-bold-markup (make-box-markup
     (number->string (ly:context-property context 'currentBarNumber)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Bass figures.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (format-new-bass-figure figure event context)
+  (let* ((fig (ly:music-property event 'figure))
+	 (fig-markup (if (number? figure)
+			 (markup #:number (number->string figure 10))
+			 #f
+			 ))
+	 (alt (ly:music-property event 'alteration))
+	 (alt-markup
+	  (if (number? alt)
+	      (markup
+		      #:general-align Y DOWN #:smaller #:smaller
+		      (alteration->text-accidental-markup alt))
+	      
+	      #f))
+	 (alt-dir (ly:context-property context 'figuredBassAlterationDirection))
+	 )
+
+    (if (and (not fig-markup) alt-markup)
+	(begin
+	  (set! fig-markup (markup #:left-align #:pad-around 0.3 alt-markup))
+	  (set! alt-markup #f)))
+
+
+    ;; hmm, how to get figures centered between note, and
+    ;; lone accidentals too?
+    
+    ;;    (if (markup? fig-markup)
+    ;;	(set!
+    ;;	 fig-markup (markup #:translate (cons 1.0 0)
+    ;;			    #:hcenter fig-markup)))
+
+    (if alt-markup
+	(set! fig-markup
+	      (markup #:put-adjacent
+		      fig-markup X
+		      (if (number? alt-dir)
+			  alt-dir
+			  LEFT)
+		      #:pad-x 0.2 alt-markup
+		      )))
+
+    (if (markup?  fig-markup)
+	fig-markup
+	empty-markup)))
+