From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Wed, 30 Mar 2005 08:39:03 +0000 (+0000)
Subject: * scm/markup.scm:
X-Git-Tag: release/2.5.18~44
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e8d8cd2d45bc06046b85c81b3cd0ba5f55c9f462;p=lilypond.git

* scm/markup.scm:
* input/regression/markup-scheme.ly:
* input/regression/markup-syntax.ly: Drop 'new-' from name.

* scm/stencil.scm (make-circle-stencil): New function.

* scm/define-markup-commands.scm (draw-circle): Use it.  New
name (was cicle).  Update callers.
(circle): New markup command, similar to box.

* scm/stencil.scm (circle-stencil): New function.
---

diff --git a/ChangeLog b/ChangeLog
index 3e6af25b2e..baf51fccfb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2005-03-30  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+	* scm/markup.scm:
+	* input/regression/markup-scheme.ly: 
+	* input/regression/markup-syntax.ly: Drop 'new-' from name.
+
+	* scm/stencil.scm (make-circle-stencil): New function.
+
+	* scm/define-markup-commands.scm (draw-circle): Use it.  New
+	name (was cicle).  Update callers.
+	(circle): New markup command, similar to box.
+
+	* scm/stencil.scm (circle-stencil): New function.
+
 2005-03-29  David Jedlinsky  <lilypond@ipnh.com>
 
 	* configure.in: Detect libutf8/wchar.h variant.
diff --git a/THANKS b/THANKS
index ae55c3ba63..fadfb53346 100644
--- a/THANKS
+++ b/THANKS
@@ -40,7 +40,6 @@ Gunther Strube
 
 BUG HUNTERS/SUGGESTIONS
 
-Jose Miguel Pasini
 Alexandre Beneteau
 Andreas Scherer
 Anthony W. Youngman
@@ -53,11 +52,13 @@ Erik Ronstr
 Fernando Pablo Lopez-Lezcano
 Jack O'Quin
 Johannes Schindelin
+Jose Miguel Pasini
 Juergen Reuter
 Karl Hammar
 Laura Conrad
 Paul Scott
 Richard Schoeller
+Roman Stöckl-Schmidt
 Tapio Tuovila
 Will Oram
 Wolfgang Hoffmann
diff --git a/input/regression/markup-scheme.ly b/input/regression/markup-scheme.ly
new file mode 100644
index 0000000000..c1f85aa4cf
--- /dev/null
+++ b/input/regression/markup-scheme.ly
@@ -0,0 +1,69 @@
+
+\header {
+
+    texidoc = "There is a Scheme macro @code{markup} to produce markup
+    texts using a similar syntax as @code{\\markup}.
+
+"
+
+    }
+\version "2.5.2"
+\score {
+     {
+        \fatText
+        f'1-\markup {
+            foo
+            \raise #0.2 \hbracket \bold bar
+            \override #'(baseline-skip . 4)
+
+            \bracket \column { baz bazr bla }
+            \hspace #2.0
+            \override #'(font-encoding . fetaMusic) {
+                \lookup #"noteheads-0"
+            }
+            \musicglyph #"accidentals.-1"
+            \combine "X" "+"   
+            \combine "o" "/"
+            \box \column { \line { "string 1" } \line { "string 2" } }
+            "$\\emptyset$"
+            \italic Norsk
+            \super "2"
+            \dynamic sfzp
+            \huge { "A" \smaller "A" \smaller \smaller "A"
+                    \smaller \smaller \smaller "A" }
+            \sub "alike"
+        }	
+        \break
+        f'1-#(markup* 
+              "foo"
+              #:raise 0.2 #:hbracket #:bold "bar"
+              #:override '(baseline-skip . 4) 
+              #:bracket #:column ( "baz" "bazr" "bla" )
+              #:hspace 2.0
+              #:override '(font-encoding . fetaMusic) #:line (#:lookup "noteheads-0" 
+                                                       )
+              #:musicglyph "accidentals.-1"
+              #:combine "X" "+"   
+              #:combine "o" "/"
+              #:box #:column ("string 1" "string 2")
+              "$\\emptyset$"
+	      #:draw-circle 1 0.3
+	      " "
+              #:italic "Norsk"
+              #:super "2"
+	      #:circle #:dynamic "p"
+	      " "
+              #:dynamic "sfzp"
+              #:huge #:line ("A" #:smaller "A" #:smaller #:smaller "A" 
+                             #:smaller #:smaller #:smaller "A")
+              #:sub "alike")
+    }
+    \layout { 
+        raggedright = ##t
+        indent = #0
+        \context {
+            \Staff
+            \remove Time_signature_engraver 
+        }
+    }
+}
diff --git a/input/regression/markup-syntax.ly b/input/regression/markup-syntax.ly
new file mode 100644
index 0000000000..ca59620d6d
--- /dev/null
+++ b/input/regression/markup-syntax.ly
@@ -0,0 +1,43 @@
+\header  {
+texidoc = "With the new markup syntax, text may be written in various manners."
+}
+
+\version "2.5.2"
+
+
+\score {
+  
+   {
+    f'-\markup {
+		foo
+		\raise #0.2 \hbracket \bold bar
+		\override #'(baseline-skip . 4)
+
+		\bracket \column { baz bazr bla }
+		\hspace #2.0
+		\override #'(font-encoding . fetaMusic) {
+			\lookup #"noteheads-0"
+		}
+		\semiflat
+
+		{ }
+		
+		\combine "X" "+"   
+		\combine "o" "/"
+%		\char-number #"abc1234abc"
+		\box \column { \line { "string 1" } \line { "string 2" } }
+		"$\\emptyset$"
+		\draw-circle #1 #0.3
+		" "
+		\italic Norsk
+		\super "2"
+		" "
+		\circle \dynamic p
+		\dynamic sfzp
+		\huge { "A" \smaller "A" \smaller \smaller "A"
+			\smaller \smaller \smaller "A" }
+		\sub "alike"
+	}	
+    c''4
+    }
+}
diff --git a/input/regression/new-markup-scheme.ly b/input/regression/new-markup-scheme.ly
deleted file mode 100644
index 6a6dea24aa..0000000000
--- a/input/regression/new-markup-scheme.ly
+++ /dev/null
@@ -1,65 +0,0 @@
-
-\header {
-
-    texidoc = "There is a Scheme macro @code{markup} to produce markup
-    texts using a similar syntax as @code{\\markup}.
-
-"
-
-    }
-\version "2.5.2"
-\score {
-     {
-        \fatText
-        f'1-\markup {
-            foo
-            \raise #0.2 \hbracket \bold bar
-            \override #'(baseline-skip . 4)
-
-            \bracket \column { baz bazr bla }
-            \hspace #2.0
-            \override #'(font-encoding . fetaMusic) {
-                \lookup #"noteheads-0"
-            }
-            \musicglyph #"accidentals.-1"
-            \combine "X" "+"   
-            \combine "o" "/"
-            \box \column { \line { "string 1" } \line { "string 2" } }
-            "$\\emptyset$"
-            \italic Norsk
-            \super "2"
-            \dynamic sfzp
-            \huge { "A" \smaller "A" \smaller \smaller "A"
-                    \smaller \smaller \smaller "A" }
-            \sub "alike"
-        }	
-        \break
-        f'1-#(markup* 
-              "foo"
-              #:raise 0.2 #:hbracket #:bold "bar"
-              #:override '(baseline-skip . 4) 
-              #:bracket #:column ( "baz" "bazr" "bla" )
-              #:hspace 2.0
-              #:override '(font-encoding . fetaMusic) #:line (#:lookup "noteheads-0" 
-                                                       )
-              #:musicglyph "accidentals.-1"
-              #:combine "X" "+"   
-              #:combine "o" "/"
-              #:box #:column ("string 1" "string 2")
-              "$\\emptyset$"
-              #:italic "Norsk"
-              #:super "2"
-              #:dynamic "sfzp"
-              #:huge #:line ("A" #:smaller "A" #:smaller #:smaller "A" 
-                             #:smaller #:smaller #:smaller "A")
-              #:sub "alike")
-    }
-    \layout { 
-        raggedright = ##t
-        indent = #0
-        \context {
-            \Staff
-            \remove Time_signature_engraver 
-        }
-    }
-}
diff --git a/input/regression/new-markup-syntax.ly b/input/regression/new-markup-syntax.ly
deleted file mode 100644
index d35606a59a..0000000000
--- a/input/regression/new-markup-syntax.ly
+++ /dev/null
@@ -1,40 +0,0 @@
-\header  {
-texidoc = "With the new markup syntax, text may be written in various manners."
-}
-
-\version "2.5.2"
-
-
-\score {
-  
-   {
-    f'-\markup {
-		foo
-		\raise #0.2 \hbracket \bold bar
-		\override #'(baseline-skip . 4)
-
-		\bracket \column { baz bazr bla }
-		\hspace #2.0
-		\override #'(font-encoding . fetaMusic) {
-			\lookup #"noteheads-0"
-		}
-		\semiflat
-
-		{ }
-		
-		\combine "X" "+"   
-		\combine "o" "/"
-%		\char-number #"abc1234abc"
-		\box \column { \line { "string 1" } \line { "string 2" } }
-		"$\\emptyset$"
-		\circle #4 #0.2
-		\italic Norsk
-		\super "2"
-		\dynamic sfzp
-		\huge { "A" \smaller "A" \smaller \smaller "A"
-			\smaller \smaller \smaller "A" }
-		\sub "alike"
-	}	
-    c''4
-    }
-}
diff --git a/po/lilypond.pot b/po/lilypond.pot
index 267b143607..f2bca67710 100644
--- a/po/lilypond.pot
+++ b/po/lilypond.pot
@@ -8,7 +8,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: PACKAGE VERSION\n"
 "Report-Msgid-Bugs-To: \n"
-"POT-Creation-Date: 2005-03-29 14:04+0200\n"
+"POT-Creation-Date: 2005-03-30 10:33+0200\n"
 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
 "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
 "Language-Team: LANGUAGE <LL@li.org>\n"
@@ -180,30 +180,30 @@ msgstr ""
 msgid "Or save as UTF-8 in your editor"
 msgstr ""
 
-#: convert-ly.py:2462
+#: convert-ly.py:2476
 msgid "Applying conversion: "
 msgstr ""
 
-#: convert-ly.py:2474
+#: convert-ly.py:2488
 #, python-format
 msgid "%s: error while converting"
 msgstr ""
 
-#: convert-ly.py:2477 score-engraver.cc:111
+#: convert-ly.py:2491 score-engraver.cc:111
 msgid "Aborting"
 msgstr ""
 
-#: convert-ly.py:2498
+#: convert-ly.py:2512
 #, python-format
 msgid "Processing `%s'... "
 msgstr ""
 
-#: convert-ly.py:2600
+#: convert-ly.py:2614
 #, python-format
 msgid "%s: cannot determine version for `%s'"
 msgstr ""
 
-#: convert-ly.py:2609
+#: convert-ly.py:2623
 #, python-format
 msgid "%s: skipping: `%s'"
 msgstr ""
@@ -1757,7 +1757,7 @@ msgstr ""
 msgid "`~a' failed (~a)"
 msgstr ""
 
-#: backend-library.scm:44 framework-tex.scm:366
+#: backend-library.scm:44 framework-tex.scm:340 framework-tex.scm:367
 #, lisp-format
 msgid "Converting to `~a'..."
 msgstr ""
@@ -1785,12 +1785,11 @@ msgstr ""
 msgid "See scm/lily.scm for supported clefs"
 msgstr ""
 
-#: framework-tex.scm:339
-#, lisp-format
-msgid "Converting to `~a'...n"
+#: define-markup-commands.scm:54
+msgid "No systems found in \\score markup.  Does it have a \\layout? block"
 msgstr ""
 
-#: framework-tex.scm:358
+#: framework-tex.scm:359
 #, lisp-format
 msgid "TeX file name must not contain whitespace: `~a'"
 msgstr ""
@@ -1805,7 +1804,7 @@ msgstr ""
 msgid "wrong type for argument ~a.  Expecting ~a, found ~s"
 msgstr ""
 
-#: lily.scm:316
+#: lily.scm:317
 msgid "error: failed files: "
 msgstr ""
 
diff --git a/po/nl.po b/po/nl.po
index 24f982d9b2..61a3f30ada 100644
--- a/po/nl.po
+++ b/po/nl.po
@@ -1837,19 +1837,13 @@ msgstr "Onbekend sleuteltype `~a'"
 msgid "See scm/lily.scm for supported clefs"
 msgstr ""
 
-# lisp-format
-#: framework-tex.scm:339
-#, fuzzy, lisp-format
-msgid "Converting to `~a'...n"
-msgstr "Converteren naar ~a..."
-
 #: framework-tex.scm:358
-#, fuzzy, lisp-format
+#, lisp-format
 msgid "TeX file name must not contain whitespace: `~a'"
-msgstr "bestandsnaam mag geen spaties bevatten: `%s'"
+msgstr "TeX bestandsnaam mag geen spaties bevatten: `~a'"
 
 #: lily-library.scm:346
-#, fuzzy, lisp-format
+#, lisp-format
 msgid "No \\version statement found.  Add~afor future compatibility."
 msgstr ""
 "Geen \\version uitdrukking gevonden.  Voeg~atoe voor toekomstige "
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 3039e18a97..f411d539c2 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -9,6 +9,8 @@
 ;;;  * each markup function should have a doc string with
 ;;     syntax, description and example. 
 
+(use-modules (ice-9 regex))
+
 (define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
 
@@ -16,28 +18,32 @@
   "Stencil as markup"
   stil)
 
-(def-markup-command (circle layout props radius thickness)
+(def-markup-command (draw-circle layout props radius thickness)
   (number? number?)
   "A circle of radius @var{radius} and thickness @var{thickness}"
+  (make-circle-stencil radius thickness))
 
-  (ly:make-stencil
-   (list 'circle radius thickness)
-   (cons (- radius) radius)
-   (cons (- radius) radius)))
+(def-markup-command (circle layout props arg) (markup?)
+  "Draw a circle around @var{arg}.  Use @code{thickness},
+@code{circle-padding} and @code{font-size} properties to determine line
+thickness and padding around the markup."
+  (let* ((th (chain-assoc-get 'thickness props  0.1))
+	 (size (chain-assoc-get 'font-size props 0))
+	 (pad
+	  (* (magstep size)
+	     (chain-assoc-get 'circle-padding props 0.2)))
+	 (m (interpret-markup layout props arg)))
+    (circle-stencil m th pad)))
 
 (def-markup-command (with-url layout props url arg) (string? markup?)
   "Add a link to URL @var{url} around @var{arg}. This only works in
 the PDF backend."
-  (let*
-      ((stil (interpret-markup layout props arg))
-       (xextent (ly:stencil-extent stil X))
-       (yextent (ly:stencil-extent stil Y))
-       (old-expr (ly:stencil-expr stil))
-       (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
-    
-    (ly:stencil-add
-     (ly:make-stencil url-expr xextent yextent)
-     stil)))
+  (let* ((stil (interpret-markup layout props arg))
+	 (xextent (ly:stencil-extent stil X))
+	 (yextent (ly:stencil-extent stil Y))
+	 (old-expr (ly:stencil-expr stil))
+	 (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
+    (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
 
 (def-markup-command (score layout props score) (ly:score?)
   "Inline an image of music."
@@ -45,12 +51,11 @@ the PDF backend."
 
     (if (= 0 (vector-length systems))
 	(begin
-	  (ly:warn "No systems found in \\score markup. Did you forget \\layout?")
+	  (ly:warn (_"No systems found in \\score markup.  Does it have a \\layout? block"))
 	  empty-markup)
 	(let* ((stencil (ly:paper-system-stencil (vector-ref systems 0)))) 
 	  
-	  (ly:stencil-aligned-to stencil Y CENTER)
-	  ))))
+	  (ly:stencil-aligned-to stencil Y CENTER)))))
 
 (def-markup-command (simple layout props str) (string?)
   "A simple text string; @code{\\markup @{ foo @}} is equivalent with
@@ -60,8 +65,7 @@ the PDF backend."
 (def-markup-command (encoded-simple layout props sym str) (symbol? string?)
   "A text string, encoded with encoding @var{sym}. See
 @usermanref{Text encoding} for more information."
-  (Text_interface::interpret_string layout
-				    props sym str))
+  (Text_interface::interpret_string layout props sym str))
 
 
 ;; TODO: use font recoding.
@@ -162,34 +166,34 @@ gsave /ecrm10 findfont
 	(stack-stencils-padding-list X RIGHT fill-space-normal line-stencils))))
 	
 (define (get-fill-space word-count line-width text-widths)
-	"Calculates the necessary paddings between each two adjacent texts.
+	"Calculate the necessary paddings between each two adjacent texts.
 	The lengths of all texts are stored in @var{text-widths}.
 	The normal formula for the padding between texts a and b is:
 	padding = line-width/(word-count - 1) - (length(a) + length(b))/2
 	The first and last padding have to be calculated specially using the
 	whole length of the first or last text.
-	Returns a list of paddings.
+	Return a list of paddings.
 "
 	(cond
-		;; special case first padding
-		((= (length text-widths) word-count)
-			(cons 
-				(- (- (/ line-width (1- word-count)) (car text-widths)) (/ (car (cdr text-widths)) 2))
-				(get-fill-space word-count line-width (cdr text-widths))))
-		;; special case last padding
-		((= (length text-widths) 2)
-			(list (- (/ line-width (1- word-count)) (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
-		(else
-			(cons 
-				(- (/ line-width (1- word-count)) (/ (+ (car text-widths) (car (cdr text-widths))) 2))
-				(get-fill-space word-count line-width (cdr text-widths))))))
+	 ;; special case first padding
+	 ((= (length text-widths) word-count)
+	  (cons 
+	   (- (- (/ line-width (1- word-count)) (car text-widths))
+	      (/ (car (cdr text-widths)) 2))
+	   (get-fill-space word-count line-width (cdr text-widths))))
+	 ;; special case last padding
+	 ((= (length text-widths) 2)
+	  (list (- (/ line-width (1- word-count))
+		   (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
+	 (else
+	  (cons 
+	   (- (/ line-width (1- word-count))
+	      (/ (+ (car text-widths) (car (cdr text-widths))) 2))
+	   (get-fill-space word-count line-width (cdr text-widths))))))
 
 (define (font-markup qualifier value)
   (lambda (layout props arg)
-    (interpret-markup layout
-		      (prepend-alist-chain qualifier value props)
-                      arg)))
-
+    (interpret-markup layout (prepend-alist-chain qualifier value props) arg)))
 
 (def-markup-command (line layout props args) (markup-list?)
   "Put @var{args} in a horizontal line.  The property @code{word-space}
@@ -232,7 +236,7 @@ determines the space between each markup in @var{args}."
                     arg))
 
 (def-markup-command (fontsize layout props mag arg) (number? markup?)
-  "This sets the relative font size, e.g.
+  "Set the relative font size, e.g.
 @example
 A \\fontsize #2 @{ B C @} D
 @end example
@@ -246,7 +250,7 @@ This will enlarge the B and the C by two steps.
    arg))
 
 (def-markup-command (magnify layout props sz arg) (number? markup?)
-  "This sets the font magnification for the its argument. In the following
+  "Set the font magnification for the its argument. In the following
 example, the middle A will be 10% larger:
 @example
 A \\magnify #1.1 @{ A @} A
@@ -398,8 +402,7 @@ of the @code{#'direction} layout property."
 (def-markup-command (vcenter layout props arg) (markup?)
   "Align @code{arg} to its Y center. "
   (let* ((mol (interpret-markup layout props arg)))
-    (ly:stencil-aligned-to mol Y CENTER)
-    ))
+    (ly:stencil-aligned-to mol Y CENTER)))
 
 (def-markup-command (hcenter layout props arg) (markup?)
   "Align @code{arg} to its X center. "
@@ -533,19 +536,18 @@ and/or @code{extra-offset} properties. "
     (if (ly:stencil? dots)
         (set! stem-glyph
               (ly:stencil-add
-               (ly:stencil-translate-axis dots
-					  (+ (if (and (> dir 0) (> log 2))
-						 (* 1.5 dotwid)
-						 0)
-					     ;; huh ? why not necessary?
-					     ;;(cdr (ly:stencil-extent head-glyph X))
-					     dotwid)
-					  X)
+               (ly:stencil-translate-axis
+		dots
+		(+ (if (and (> dir 0) (> log 2))
+		       (* 1.5 dotwid)
+		       0)
+		   ;; huh ? why not necessary?
+		   ;;(cdr (ly:stencil-extent head-glyph X))
+		   dotwid)
+		X)
                stem-glyph)))
     stem-glyph))
 
-(use-modules (ice-9 regex))
-
 (define-public log2 
   (let ((divisor (log 2)))
     (lambda (z) (inexact->exact (/ (log z) divisor)))))
@@ -556,8 +558,8 @@ and/or @code{extra-offset} properties. "
     (if (and match (string=? duration-string (match:substring match 0)))
         (let ((len  (match:substring match 1))
               (dots (match:substring match 2)))
-          (list (cond ((string=? len "breve")  -1)
-                      ((string=? len "longa")  -2)
+          (list (cond ((string=? len "breve") -1)
+                      ((string=? len "longa") -2)
                       ((string=? len "maxima") -3)
                       (else (log2 (string->number len))))
                 (if dots (string-length dots) 0)))
@@ -573,11 +575,9 @@ a shortened down stem."
 
 (def-markup-command (normal-size-super layout props arg) (markup?)
   "Set @var{arg} in superscript with a normal font size."
-  (ly:stencil-translate-axis (interpret-markup
-			      layout
-			      props arg)
-			     (* 0.5  (chain-assoc-get 'baseline-skip props))
-			     Y))
+  (ly:stencil-translate-axis
+   (interpret-markup layout props arg)
+   (* 0.5 (chain-assoc-get 'baseline-skip props)) Y))
 
 (def-markup-command (super layout props arg) (markup?)
   "
@@ -629,14 +629,13 @@ that.
    (* -0.5 (chain-assoc-get 'baseline-skip props))
    Y))
 
-(def-markup-command (beam layout props width slope thickness) (number? number? number?)
+(def-markup-command (beam layout props width slope thickness)
+  (number? number? number?)
   "Create a beam with the specified parameters."
+  (let* ((y (* slope width))
+	 (yext (cons (min 0 y) (max 0 y)))
+	 (half (/ thickness 2)))
 
-  (let*
-      ((y (* slope width))
-       (yext (cons (min 0 y) (max 0 y)))
-       (half (/ thickness 2)))
-       
     (ly:make-stencil
      (list 'beam width
 	   slope
@@ -644,10 +643,7 @@ that.
 	   (ly:output-def-lookup layout 'blotdiameter))
      (cons 0 width)
      (cons (+ (- half) (car yext))
-	   (+ half (cdr yext))))
-
-    ))
-
+	   (+ half (cdr yext))))))
 
 (def-markup-command (normal-size-sub layout props arg) (markup?)
   "Set @var{arg} in subscript, in a normal font size."
@@ -723,9 +719,8 @@ any sort of property supported by @internalsref{font-interface} and
 thickness and padding around the markup."
   (let* ((th (chain-assoc-get 'thickness props  0.1))
 	 (size (chain-assoc-get 'font-size props 0))
-	 (pad
-	  (* (magstep size)
-	     (chain-assoc-get 'box-padding props 0.2)))
+	 (pad (* (magstep size)
+		 (chain-assoc-get 'box-padding props 0.2)))
 	 (m (interpret-markup layout props arg)))
     (box-stencil m th pad)))
 
diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm
index 17bf2406c0..4ad34baa80 100644
--- a/scm/framework-tex.scm
+++ b/scm/framework-tex.scm
@@ -335,9 +335,10 @@
     (if (access? ps-name W_OK)
 	(delete-file ps-name))
     (if (not (ly:get-option 'verbose))
-	(format (current-error-port)
-		(_ "Converting to `~a'...\n")
-		(string-append base ".dvi")))
+	(begin
+	  (format (current-error-port)
+		  (_ "Converting to `~a'...") (string-append base ".dvi"))
+	  (newline (current-error-port))))
     (ly:system cmd)))
 
 (define-public (convert-to-dvi book name)
diff --git a/scm/lily.scm b/scm/lily.scm
index 0ce3c55ef3..1ce64cca76 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -141,6 +141,7 @@ predicates. Print a message at LOCATION if any predicate failed."
     round-filled-box
     text
     url-link
+    utf8-string
     white-dot
     white-text
     embedded-ps
@@ -193,7 +194,7 @@ The syntax is the same as `define*-public'."
 	    "chord-entry.scm"
 	    "chord-generic-names.scm"
 	    "stencil.scm"
-	    "new-markup.scm"
+	    "markup.scm"
 	    "bass-figure.scm"
 	    "music-functions.scm"
 	    "part-combiner.scm"
diff --git a/scm/markup.scm b/scm/markup.scm
new file mode 100644
index 0000000000..103c2e6e7d
--- /dev/null
+++ b/scm/markup.scm
@@ -0,0 +1,454 @@
+;;;; markup.scm -- Implement a user extensible markup scheme.
+;;;;
+;;;;  source file of the GNU LilyPond music typesetter
+;;;; 
+;;;; (c) 2003--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+"
+Internally markup is stored as lists, whose head is a function.
+
+  (FUNCTION ARG1 ARG2 ... )
+
+When the markup is formatted, then FUNCTION is called as follows
+
+  (FUNCTION GROB PROPS ARG1 ARG2 ... ) 
+
+GROB is the current grob, PROPS is a list of alists, and ARG1.. are
+the rest of the arguments.
+
+The function should return a stencil (i.e. a formatted, ready to
+print object).
+
+
+To add a function, use the def-markup-command utility.
+
+  (def-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
+    \"my command usage and description\"
+    ...function body...)
+
+The command is now available in markup mode, e.g.
+
+
+  \\markup { .... \\MYCOMMAND #1 argument ... }
+
+" ; "
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; markup definer utilities
+;;; `def-markup-command' can be used both for built-in markup
+;;; definitions and user defined markups.
+
+(defmacro-public def-markup-command (command-and-args signature . body)
+  "
+
+* Define a COMMAND-markup function after command-and-args and body,
+register COMMAND-markup and its signature,
+
+* add COMMAND-markup to markup-function-list,
+
+* sets COMMAND-markup markup-signature and markup-keyword object properties,
+
+* define a make-COMMAND-markup function.
+
+Syntax:
+  (def-markup-command (COMMAND layout props arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    \"documentation string\"
+    ...command body...)
+ or:
+  (def-markup-command COMMAND (arg1-type? arg2-type? ...)
+    function)
+"
+  (let* ((command (if (pair? command-and-args) (car command-and-args) command-and-args))
+         (args (if (pair? command-and-args) (cdr command-and-args) '()))
+         (command-name (string->symbol (string-append (symbol->string command) "-markup")))
+         (make-markup-name (string->symbol (string-append "make-" (symbol->string command-name)))))
+    `(begin
+       (define-public ,(if (pair? args)
+                           (cons command-name args)
+                           command-name)
+         ,@body)
+       (set! (markup-command-signature ,command-name) (list ,@signature))
+       (if (not (member ,command-name markup-function-list))
+           (set! markup-function-list (cons ,command-name markup-function-list)))
+       (define-public (,make-markup-name . args)
+         (let ((sig (list ,@signature)))
+           (make-markup ,command-name ,(symbol->string make-markup-name) sig args))))))
+
+(define-public (make-markup markup-function make-name signature args)
+  " Construct a markup object from MARKUP-FUNCTION and ARGS. Typecheck
+against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
+"
+  (let* ((arglen (length args))
+         (siglen (length signature))
+         (error-msg (if (and (> siglen 0) (> arglen 0))
+                        (markup-argument-list-error signature args 1)
+                        #f)))
+    (if (or (not (= arglen siglen)) (< siglen 0) (< arglen 0))
+        (scm-error 'markup-format make-name
+                   "Expect ~A arguments for ~A. Found ~A: ~S"
+                   (list siglen make-name arglen args)
+                   #f))
+    (if error-msg
+        (scm-error 'markup-format make-name
+                   "Invalid argument in position ~A\nExpect: ~A\nFound: ~S."
+                   error-msg #f)
+        (cons markup-function args))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; markup constructors
+;;; lilypond-like syntax for markup construction in scheme.
+
+(use-modules (ice-9 optargs)
+             (ice-9 receive))
+
+(defmacro*-public markup (#:rest body)
+  "The `markup' macro provides a lilypond-like syntax for building markups.
+
+ - #:COMMAND is used instead of \\COMMAND
+ - #:lines ( ... ) is used instead of { ... }
+ - #:center-align ( ... ) is used instead of \\center-align < ... >
+ - etc.
+
+Example:
+  \\markup { foo
+            \\raise #0.2 \\hbracket \\bold bar
+            \\override #'(baseline-skip . 4)
+            \\bracket \\column < baz bazr bla >
+  }
+         <==>
+  (markup \"foo\"
+          #:raise 0.2 #:hbracket #:bold \"bar\"
+          #:override '(baseline-skip . 4) 
+          #:bracket #:column (\"baz\" \"bazr\" \"bla\"))
+Use `markup*' in a \\notes block."
+  
+  (car (compile-all-markup-expressions `(#:line ,body))))
+
+(defmacro*-public markup* (#:rest body)
+  "Same as `markup', for use in a \\notes block."
+  `(ly:export (markup ,@body)))
+  
+  
+(define (compile-all-markup-expressions expr)
+  "Return a list of canonical markups expressions, e.g.:
+  (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
+  ===>
+  ((make-COMMAND1-markup arg11 arg12)
+   (make-COMMAND2-markup arg21 arg22 arg23) ...)"
+  (do ((rest expr rest)
+       (markps '() markps))
+      ((null? rest) (reverse markps))
+    (receive (m r) (compile-markup-expression rest)
+             (set! markps (cons m markps))
+             (set! rest r))))
+
+(define (keyword->make-markup key)
+  "Transform a keyword, e.g. #:COMMAND, in a make-COMMAND-markup symbol."
+  (string->symbol (string-append "make-" (symbol->string (keyword->symbol key)) "-markup")))
+
+(define (compile-markup-expression expr)
+  "Return two values: the first complete canonical markup expression found in `expr',
+e.g. (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
+  (cond ((and (pair? expr)
+              (keyword? (car expr)))
+         ;; expr === (#:COMMAND arg1 ...)
+         (let* ((command (symbol->string (keyword->symbol (car expr))))
+                (sig (markup-command-signature (car (lookup-markup-command command))))
+                (sig-len (length sig)))
+           (do ((i 0 (1+ i))
+                (args '() args)
+                (rest (cdr expr) rest))
+               ((>= i sig-len)
+                (values (cons (keyword->make-markup (car expr)) (reverse args)) rest))
+             (cond ((eqv? (list-ref sig i) markup-list?)
+                    ;; (car rest) is a markup list
+                    (set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args))
+                    (set! rest (cdr rest)))
+                   (else
+                    ;; pick up one arg in `rest'
+                    (receive (a r) (compile-markup-arg rest)
+                             (set! args (cons a args))
+                             (set! rest r)))))))
+        ((and (pair? expr)
+              (pair? (car expr))
+              (keyword? (caar expr)))
+         ;; expr === ((#:COMMAND arg1 ...) ...)
+         (receive (m r) (compile-markup-expression (car expr))
+                  (values m (cdr expr))))
+        ((and (pair? expr)
+              (string? (car expr))) ;; expr === ("string" ...)
+         (values `(make-simple-markup ,(car expr)) (cdr expr)))
+        (else
+         ;; expr === (symbol ...) or ((funcall ...) ...)
+         (values (car expr)
+                 (cdr expr)))))
+
+(define (compile-all-markup-args expr)
+  "Transform `expr' into markup arguments"
+  (do ((rest expr rest)
+       (args '() args))
+      ((null? rest) (reverse args))
+    (receive (a r) (compile-markup-arg rest)
+             (set! args (cons a args))
+             (set! rest r))))
+
+(define (compile-markup-arg expr)
+  "Return two values: the desired markup argument, and the rest arguments"
+  (cond ((null? expr)
+         ;; no more args
+         (values '() '()))
+        ((keyword? (car expr))
+         ;; expr === (#:COMMAND ...)
+         ;; ==> build and return the whole markup expression
+         (compile-markup-expression expr))
+        ((and (pair? (car expr))
+              (keyword? (caar expr)))
+         ;; expr === ((#:COMMAND ...) ...)
+         ;; ==> build and return the whole markup expression(s)
+         ;; found in (car expr)
+         (receive (markup-expr rest-expr) (compile-markup-expression (car expr))
+                  (if (null? rest-expr)
+                      (values markup-expr (cdr expr))
+                      (values `(list ,markup-expr ,@(compile-all-markup-args rest-expr))
+                              (cdr expr)))))
+        ((and (pair? (car expr))
+              (pair? (caar expr)))
+         ;; expr === (((foo ...) ...) ...)
+         (values (cons 'list (compile-all-markup-args (car expr))) (cdr expr)))
+        (else (values (car expr) (cdr expr)))))
+
+;;;;;;;;;;;;;;;
+;;; Debugging utilities: print markup expressions in a friendly fashion
+
+(use-modules (ice-9 format))
+(define (markup->string markup-expr)
+  "Return a string describing, in LilyPond syntax, the given markup expression."
+  (define (proc->command proc)
+    (let ((cmd-markup (symbol->string (procedure-name proc))))
+      (substring cmd-markup 0 (- (string-length cmd-markup)
+                                 (string-length "-markup")))))
+  (define (arg->string arg)
+    (cond ((and (pair? arg) (pair? (car arg))) ;; markup list
+           (format #f "~{ ~a~}" (map markup->string arg)))
+          ((pair? arg)                         ;; markup
+           (markup->string arg))
+          ((string? arg)                       ;; scheme string argument
+           (format #f "#\"~a\"" arg))
+          (else                                ;; other scheme arg
+           (format #f "#~a" arg))))
+  (let ((cmd (car markup-expr))
+        (args (cdr markup-expr)))
+    (cond ((eqv? cmd simple-markup) ;; a simple string
+           (format #f "\"~a\"" (car args)))
+          ((eqv? cmd line-markup)   ;; { ... }
+           (format #f "{~a}" (arg->string (car args))))
+          ((eqv? cmd center-align-markup) ;; \center < ... >
+           (format #f "\\center-align <~a>" (arg->string (car args))))
+          ((eqv? cmd column-markup) ;; \column < ... >
+           (format #f "\\column <~a>" (arg->string (car args))))
+          (else                ;; \command ...
+           (format #f "\\~a~{ ~a~} " (proc->command cmd) (map arg->string args))))))
+
+(define-public (display-markup markup-expr)
+  "Print a LilyPond-syntax equivalent for the given markup expression."
+  (display "\\markup ")
+  (display (markup->string markup-expr)))
+
+;;;;;;;;;;;;;;;
+;;; Utilities for storing and accessing markup commands signature
+;;; and keyword.
+;;; Examples:
+;;;
+;;; (set! (markup-command-signature raise-markup) (list number? markup?))
+;;; ==> ((#<primitive-procedure number?> #<procedure markup? (obj)>) . scheme0-markup1)
+;;;
+;;; (markup-command-signature raise-markup)
+;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
+;;;
+;;; (markup-command-keyword raise-markup) ==> "scheme0-markup1"
+;;; 
+
+(define markup-command-signatures (make-hash-table 50))
+
+(define (markup-command-signature-ref markup-command)
+  "Return markup-command's signature, e.g. (number? markup?).
+markup-command may be a procedure."
+  (let ((sig-key (hashq-ref markup-command-signatures
+                            markup-command)))
+    (if sig-key (car sig-key) #f)))
+
+(define-public (markup-command-keyword markup-command)
+  "Return markup-command's keyword, e.g. \"scheme0markup1\".
+markup-command may be a procedure."
+  (let ((sig-key (hashq-ref markup-command-signatures
+                            markup-command)))
+    (if sig-key (cdr sig-key) #f)))
+
+(define (markup-command-signatureset! markup-command signature)
+  "Set markup-command's signature. markup-command must be a named procedure.
+Also set markup-signature and markup-keyword object properties."
+  (hashq-set! markup-command-signatures
+              markup-command
+              (cons signature (markup-signature-to-keyword signature)))
+  ;; these object properties are still in use somewhere
+  (set-object-property! markup-command 'markup-signature signature)
+  (set-object-property! markup-command 'markup-keyword (markup-signature-to-keyword signature)))
+  
+(define-public markup-command-signature
+  (make-procedure-with-setter markup-command-signature-ref markup-command-signatureset!))
+
+(define (markup-symbol-to-proc markup-sym)
+  "Return the markup command procedure which name is `markup-sym', if any."
+  (hash-fold (lambda (key val prev)
+                            (or prev
+                                (if (eqv? (procedure-name key) markup-sym) key #f)))
+             #f
+             markup-command-signatures))
+
+(define-public markup-function-list '())
+
+(define-public (markup-signature-to-keyword sig)
+  " (A B C) -> a0-b1-c2 "
+  (if (null? sig)
+      'empty
+      (string->symbol (string-join (map
+                                    (let* ((count 0))
+                                      (lambda (func)
+                                        (set! count (+ count 1))
+                                        (string-append
+                                         ;; for reasons I don't get,
+                                         ;; (case func ((markup?) .. )
+                                         ;; doesn't work.
+                                         (cond 
+                                          ((eq? func markup?) "markup")
+                                          ((eq? func markup-list?) "markup-list")
+                                          (else "scheme"))
+                                         (number->string (- count 1)))))
+                                    sig)
+                         "-"))))
+
+(define-public (lookup-markup-command code)
+  (let ((proc (markup-symbol-to-proc (string->symbol (string-append code "-markup")))))
+    (and proc (cons proc (markup-command-keyword proc)))))
+
+;;;;;;;;;;;;;;;;;;;;;;
+;;; used in parser.yy to map a list of markup commands on markup arguments
+(define-public (map-markup-command-list commands markups)
+  "`markups' being a list of markups, eg (markup1 markup2 markup3),
+and `commands' a list of commands with their scheme arguments, in reverse order,
+eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
+ ((bold (raise 4 (italic markup1)))
+  (bold (raise 4 (italic markup2)))
+  (bold (raise 4 (italic markup3))))
+"
+  (map-in-order (lambda (arg)
+                  (let ((result arg))
+                    (for-each (lambda (cmd)
+                                (set! result (append cmd (list result))))
+                              commands)
+                    result))
+                markups))
+
+;;;;;;;;;;;;;;;;;;;;;;
+;;; markup type predicates
+
+(define (markup-function? x)
+  (not (not (markup-command-signature x))))
+
+(define-public (markup-list? arg)
+  (define (markup-list-inner? lst)
+    (or (null? lst)
+        (and (markup? (car lst)) (markup-list-inner? (cdr lst)))))
+  (and (list? arg) (markup-list-inner? arg)))
+
+(define (markup-argument-list? signature arguments)
+  "Typecheck argument list."
+  (if (and (pair? signature) (pair? arguments))
+      (and ((car signature) (car arguments))
+           (markup-argument-list? (cdr signature) (cdr arguments)))
+      (and (null? signature) (null? arguments))))
+
+
+(define (markup-argument-list-error signature arguments number)
+  "return (ARG-NR TYPE-EXPECTED ARG-FOUND) if an error is detected, or
+#f is no error found.
+"
+  (if (and (pair? signature) (pair? arguments))
+      (if (not ((car signature) (car arguments)))
+          (list number (type-name (car signature)) (car arguments))
+          (markup-argument-list-error (cdr signature) (cdr arguments) (+ 1 number)))
+      #f))
+
+;;
+;; full recursive typecheck.
+;;
+(define (markup-typecheck? arg)
+  (or (string? arg)
+      (and (pair? arg)
+           (markup-function? (car arg))
+           (markup-argument-list? (markup-command-signature (car arg))
+                                  (cdr arg)))))
+
+;; 
+;; typecheck, and throw an error when something amiss.
+;; 
+(define (markup-thrower-typecheck arg)
+  (cond ((string? arg) #t)
+        ((not (pair? arg))
+         (throw 'markup-format "Not a pair" arg))
+        ((not (markup-function? (car arg)))
+         (throw 'markup-format "Not a markup function " (car arg)))
+        ((not (markup-argument-list? (markup-command-signature (car arg))
+                                     (cdr arg)))
+         (throw 'markup-format "Arguments failed  typecheck for " arg)))
+  #t)
+
+;;
+;; good enough if you only  use make-XXX-markup functions.
+;; 
+(define (cheap-markup? x)
+  (or (string? x)
+      (and (pair? x)
+           (markup-function? (car x)))))
+
+;;
+;; replace by markup-thrower-typecheck for more detailed diagnostics.
+;; 
+(define-public markup? cheap-markup?)
+
+;; utility
+
+(define (markup-join markups sep)
+  "Return line-markup of MARKUPS, joining them with markup SEP"
+  (if (pair? markups)
+      (make-line-markup (list-insert-separator markups sep))
+      empty-markup))
+
+;; unused?
+;;(define-public brew-markup-stencil Text_interface::print)
+
+(define-public interpret-markup Text_interface::interpret_markup)
+(define-public (prepend-alist-chain key val chain)
+  (cons (acons key val (car chain)) (cdr chain)))
+
+(define-public (stack-stencil-line space stencils)
+  "DOCME"
+  (if (and (pair? stencils)
+	   (ly:stencil? (car stencils)))
+      
+      (if (and (pair? (cdr stencils))
+	       (ly:stencil? (cadr stencils)))
+          (let* ((tail (stack-stencil-line  space (cdr stencils)))
+                 (head (car stencils))
+                 (xoff (+ space (cdr (ly:stencil-extent head X)))))
+            (ly:stencil-add head
+                             (ly:stencil-translate-axis tail xoff X)))
+          (car stencils))
+      (ly:make-stencil '() '(0 . 0) '(0 . 0))))
+
+
+
+
+
+
+
diff --git a/scm/new-markup.scm b/scm/new-markup.scm
deleted file mode 100644
index 4842fb44a5..0000000000
--- a/scm/new-markup.scm
+++ /dev/null
@@ -1,455 +0,0 @@
-;;;; new-markup.scm -- Implement a user extensible markup scheme.
-;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 2003--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-
-"
-Internally markup is stored as lists, whose head is a function.
-
-  (FUNCTION ARG1 ARG2 ... )
-
-When the markup is formatted, then FUNCTION is called as follows
-
-  (FUNCTION GROB PROPS ARG1 ARG2 ... ) 
-
-GROB is the current grob, PROPS is a list of alists, and ARG1.. are
-the rest of the arguments.
-
-The function should return a stencil (i.e. a formatted, ready to
-print object).
-
-
-To add a function, use the def-markup-command utility.
-
-  (def-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
-    \"my command usage and description\"
-    ...function body...)
-
-The command is now available in markup mode, e.g.
-
-
-  \\markup { .... \\MYCOMMAND #1 argument ... }
-
-" ; "
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; markup definer utilities
-;;; `def-markup-command' can be used both for built-in markup
-;;; definitions and user defined markups.
-
-(defmacro-public def-markup-command (command-and-args signature . body)
-  "
-
-* Define a COMMAND-markup function after command-and-args and body,
-register COMMAND-markup and its signature,
-
-* add COMMAND-markup to markup-function-list,
-
-* sets COMMAND-markup markup-signature and markup-keyword object properties,
-
-* define a make-COMMAND-markup function.
-
-Syntax:
-  (def-markup-command (COMMAND layout props arg1 arg2 ...) (arg1-type? arg2-type? ...)
-    \"documentation string\"
-    ...command body...)
- or:
-  (def-markup-command COMMAND (arg1-type? arg2-type? ...)
-    function)
-"
-  (let* ((command (if (pair? command-and-args) (car command-and-args) command-and-args))
-         (args (if (pair? command-and-args) (cdr command-and-args) '()))
-         (command-name (string->symbol (string-append (symbol->string command) "-markup")))
-         (make-markup-name (string->symbol (string-append "make-" (symbol->string command-name)))))
-    `(begin
-       (define-public ,(if (pair? args)
-                           (cons command-name args)
-                           command-name)
-         ,@body)
-       (set! (markup-command-signature ,command-name) (list ,@signature))
-       (if (not (member ,command-name markup-function-list))
-           (set! markup-function-list (cons ,command-name markup-function-list)))
-       (define-public (,make-markup-name . args)
-         (let ((sig (list ,@signature)))
-           (make-markup ,command-name ,(symbol->string make-markup-name) sig args))))))
-
-(define-public (make-markup markup-function make-name signature args)
-  " Construct a markup object from MARKUP-FUNCTION and ARGS. Typecheck
-against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
-"
-  (let* ((arglen (length args))
-         (siglen (length signature))
-         (error-msg (if (and (> siglen 0) (> arglen 0))
-                        (markup-argument-list-error signature args 1)
-                        #f)))
-    (if (or (not (= arglen siglen)) (< siglen 0) (< arglen 0))
-        (scm-error 'markup-format make-name
-                   "Expect ~A arguments for ~A. Found ~A: ~S"
-                   (list siglen make-name arglen args)
-                   #f))
-    (if error-msg
-        (scm-error 'markup-format make-name
-                   "Invalid argument in position ~A\nExpect: ~A\nFound: ~S."
-                   error-msg #f)
-        (cons markup-function args))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; markup constructors
-;;; lilypond-like syntax for markup construction in scheme.
-
-(use-modules (ice-9 optargs)
-             (ice-9 receive))
-
-(defmacro*-public markup (#:rest body)
-  "The `markup' macro provides a lilypond-like syntax for building markups.
-
- - #:COMMAND is used instead of \\COMMAND
- - #:lines ( ... ) is used instead of { ... }
- - #:center-align ( ... ) is used instead of \\center-align < ... >
- - etc.
-
-Example:
-  \\markup { foo
-            \\raise #0.2 \\hbracket \\bold bar
-            \\override #'(baseline-skip . 4)
-            \\bracket \\column < baz bazr bla >
-  }
-         <==>
-  (markup \"foo\"
-          #:raise 0.2 #:hbracket #:bold \"bar\"
-          #:override '(baseline-skip . 4) 
-          #:bracket #:column (\"baz\" \"bazr\" \"bla\"))
-Use `markup*' in a \\notes block."
-  
-  (car (compile-all-markup-expressions `(#:line ,body))))
-
-(defmacro*-public markup* (#:rest body)
-  "Same as `markup', for use in a \\notes block."
-  `(ly:export (markup ,@body)))
-  
-  
-(define (compile-all-markup-expressions expr)
-  "Return a list of canonical markups expressions, e.g.:
-  (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
-  ===>
-  ((make-COMMAND1-markup arg11 arg12)
-   (make-COMMAND2-markup arg21 arg22 arg23) ...)"
-  (do ((rest expr rest)
-       (markps '() markps))
-      ((null? rest) (reverse markps))
-    (receive (m r) (compile-markup-expression rest)
-             (set! markps (cons m markps))
-             (set! rest r))))
-
-(define (keyword->make-markup key)
-  "Transform a keyword, e.g. #:COMMAND, in a make-COMMAND-markup symbol."
-  (string->symbol (string-append "make-" (symbol->string (keyword->symbol key)) "-markup")))
-
-(define (compile-markup-expression expr)
-  "Return two values: the first complete canonical markup expression found in `expr',
-e.g. (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
-  (cond ((and (pair? expr)
-              (keyword? (car expr)))
-         ;; expr === (#:COMMAND arg1 ...)
-         (let* ((command (symbol->string (keyword->symbol (car expr))))
-                (sig (markup-command-signature (car (lookup-markup-command command))))
-                (sig-len (length sig)))
-           (do ((i 0 (1+ i))
-                (args '() args)
-                (rest (cdr expr) rest))
-               ((>= i sig-len)
-                (values (cons (keyword->make-markup (car expr)) (reverse args)) rest))
-             (cond ((eqv? (list-ref sig i) markup-list?)
-                    ;; (car rest) is a markup list
-                    (set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args))
-                    (set! rest (cdr rest)))
-                   (else
-                    ;; pick up one arg in `rest'
-                    (receive (a r) (compile-markup-arg rest)
-                             (set! args (cons a args))
-                             (set! rest r)))))))
-        ((and (pair? expr)
-              (pair? (car expr))
-              (keyword? (caar expr)))
-         ;; expr === ((#:COMMAND arg1 ...) ...)
-         (receive (m r) (compile-markup-expression (car expr))
-                  (values m (cdr expr))))
-        ((and (pair? expr)
-              (string? (car expr))) ;; expr === ("string" ...)
-         (values `(make-simple-markup ,(car expr)) (cdr expr)))
-        (else
-         ;; expr === (symbol ...) or ((funcall ...) ...)
-         (values (car expr)
-                 (cdr expr)))))
-
-(define (compile-all-markup-args expr)
-  "Transform `expr' into markup arguments"
-  (do ((rest expr rest)
-       (args '() args))
-      ((null? rest) (reverse args))
-    (receive (a r) (compile-markup-arg rest)
-             (set! args (cons a args))
-             (set! rest r))))
-
-(define (compile-markup-arg expr)
-  "Return two values: the desired markup argument, and the rest arguments"
-  (cond ((null? expr)
-         ;; no more args
-         (values '() '()))
-        ((keyword? (car expr))
-         ;; expr === (#:COMMAND ...)
-         ;; ==> build and return the whole markup expression
-         (compile-markup-expression expr))
-        ((and (pair? (car expr))
-              (keyword? (caar expr)))
-         ;; expr === ((#:COMMAND ...) ...)
-         ;; ==> build and return the whole markup expression(s)
-         ;; found in (car expr)
-         (receive (markup-expr rest-expr) (compile-markup-expression (car expr))
-                  (if (null? rest-expr)
-                      (values markup-expr (cdr expr))
-                      (values `(list ,markup-expr ,@(compile-all-markup-args rest-expr))
-                              (cdr expr)))))
-        ((and (pair? (car expr))
-              (pair? (caar expr)))
-         ;; expr === (((foo ...) ...) ...)
-         (values (cons 'list (compile-all-markup-args (car expr))) (cdr expr)))
-        (else (values (car expr) (cdr expr)))))
-
-;;;;;;;;;;;;;;;
-;;; Debugging utilities: print markup expressions in a friendly fashion
-
-(use-modules (ice-9 format))
-(define (markup->string markup-expr)
-  "Return a string describing, in LilyPond syntax, the given markup expression."
-  (define (proc->command proc)
-    (let ((cmd-markup (symbol->string (procedure-name proc))))
-      (substring cmd-markup 0 (- (string-length cmd-markup)
-                                 (string-length "-markup")))))
-  (define (arg->string arg)
-    (cond ((and (pair? arg) (pair? (car arg))) ;; markup list
-           (format #f "~{ ~a~}" (map markup->string arg)))
-          ((pair? arg)                         ;; markup
-           (markup->string arg))
-          ((string? arg)                       ;; scheme string argument
-           (format #f "#\"~a\"" arg))
-          (else                                ;; other scheme arg
-           (format #f "#~a" arg))))
-  (let ((cmd (car markup-expr))
-        (args (cdr markup-expr)))
-    (cond ((eqv? cmd simple-markup) ;; a simple string
-           (format #f "\"~a\"" (car args)))
-          ((eqv? cmd line-markup)   ;; { ... }
-           (format #f "{~a}" (arg->string (car args))))
-          ((eqv? cmd center-align-markup) ;; \center < ... >
-           (format #f "\\center-align <~a>" (arg->string (car args))))
-          ((eqv? cmd column-markup) ;; \column < ... >
-           (format #f "\\column <~a>" (arg->string (car args))))
-          (else                ;; \command ...
-           (format #f "\\~a~{ ~a~} " (proc->command cmd) (map arg->string args))))))
-
-(define-public (display-markup markup-expr)
-  "Print a LilyPond-syntax equivalent for the given markup expression."
-  (display "\\markup ")
-  (display (markup->string markup-expr)))
-
-;;;;;;;;;;;;;;;
-;;; Utilities for storing and accessing markup commands signature
-;;; and keyword.
-;;; Examples:
-;;;
-;;; (set! (markup-command-signature raise-markup) (list number? markup?))
-;;; ==> ((#<primitive-procedure number?> #<procedure markup? (obj)>) . scheme0-markup1)
-;;;
-;;; (markup-command-signature raise-markup)
-;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
-;;;
-;;; (markup-command-keyword raise-markup) ==> "scheme0-markup1"
-;;; 
-
-(define markup-command-signatures (make-hash-table 50))
-
-(define (markup-command-signature-ref markup-command)
-  "Return markup-command's signature, e.g. (number? markup?).
-markup-command may be a procedure."
-  (let ((sig-key (hashq-ref markup-command-signatures
-                            markup-command)))
-    (if sig-key (car sig-key) #f)))
-
-(define-public (markup-command-keyword markup-command)
-  "Return markup-command's keyword, e.g. \"scheme0markup1\".
-markup-command may be a procedure."
-  (let ((sig-key (hashq-ref markup-command-signatures
-                            markup-command)))
-    (if sig-key (cdr sig-key) #f)))
-
-(define (markup-command-signatureset! markup-command signature)
-  "Set markup-command's signature. markup-command must be a named procedure.
-Also set markup-signature and markup-keyword object properties."
-  (hashq-set! markup-command-signatures
-              markup-command
-              (cons signature (markup-signature-to-keyword signature)))
-  ;; these object properties are still in use somewhere
-  (set-object-property! markup-command 'markup-signature signature)
-  (set-object-property! markup-command 'markup-keyword (markup-signature-to-keyword signature)))
-  
-(define-public markup-command-signature
-  (make-procedure-with-setter markup-command-signature-ref markup-command-signatureset!))
-
-(define (markup-symbol-to-proc markup-sym)
-  "Return the markup command procedure which name is `markup-sym', if any."
-  (hash-fold (lambda (key val prev)
-                            (or prev
-                                (if (eqv? (procedure-name key) markup-sym) key #f)))
-             #f
-             markup-command-signatures))
-
-(define-public markup-function-list '())
-
-(define-public (markup-signature-to-keyword sig)
-  " (A B C) -> a0-b1-c2 "
-  (if (null? sig)
-      'empty
-      (string->symbol (string-join (map
-                                    (let* ((count 0))
-                                      (lambda (func)
-                                        (set! count (+ count 1))
-                                        (string-append
-                                         ;; for reasons I don't get,
-                                         ;; (case func ((markup?) .. )
-                                         ;; doesn't work.
-                                         (cond 
-                                          ((eq? func markup?) "markup")
-                                          ((eq? func markup-list?) "markup-list")
-                                          (else "scheme"))
-                                         (number->string (- count 1)))))
-                                    sig)
-                         "-"))))
-
-(define-public (lookup-markup-command code)
-  (let ((proc (markup-symbol-to-proc (string->symbol (string-append code "-markup")))))
-    (and proc (cons proc (markup-command-keyword proc)))))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;;; used in parser.yy to map a list of markup commands on markup arguments
-(define-public (map-markup-command-list commands markups)
-  "`markups' being a list of markups, eg (markup1 markup2 markup3),
-and `commands' a list of commands with their scheme arguments, in reverse order,
-eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
- ((bold (raise 4 (italic markup1)))
-  (bold (raise 4 (italic markup2)))
-  (bold (raise 4 (italic markup3))))
-"
-  (map-in-order (lambda (arg)
-                  (let ((result arg))
-                    (for-each (lambda (cmd)
-                                (set! result (append cmd (list result))))
-                              commands)
-                    result))
-                markups))
-
-;;;;;;;;;;;;;;;;;;;;;;
-;;; markup type predicates
-
-(define (markup-function? x)
-  (not (not (markup-command-signature x))))
-
-(define-public (markup-list? arg)
-  (define (markup-list-inner? lst)
-    (or (null? lst)
-        (and (markup? (car lst)) (markup-list-inner? (cdr lst)))))
-  (and (list? arg) (markup-list-inner? arg)))
-
-(define (markup-argument-list? signature arguments)
-  "Typecheck argument list."
-  (if (and (pair? signature) (pair? arguments))
-      (and ((car signature) (car arguments))
-           (markup-argument-list? (cdr signature) (cdr arguments)))
-      (and (null? signature) (null? arguments))))
-
-
-(define (markup-argument-list-error signature arguments number)
-  "return (ARG-NR TYPE-EXPECTED ARG-FOUND) if an error is detected, or
-#f is no error found.
-"
-  (if (and (pair? signature) (pair? arguments))
-      (if (not ((car signature) (car arguments)))
-          (list number (type-name (car signature)) (car arguments))
-          (markup-argument-list-error (cdr signature) (cdr arguments) (+ 1 number)))
-      #f))
-
-;;
-;; full recursive typecheck.
-;;
-(define (markup-typecheck? arg)
-  (or (string? arg)
-      (and (pair? arg)
-           (markup-function? (car arg))
-           (markup-argument-list? (markup-command-signature (car arg))
-                                  (cdr arg)))))
-
-;; 
-;; typecheck, and throw an error when something amiss.
-;; 
-(define (markup-thrower-typecheck arg)
-  (cond ((string? arg) #t)
-        ((not (pair? arg))
-         (throw 'markup-format "Not a pair" arg))
-        ((not (markup-function? (car arg)))
-         (throw 'markup-format "Not a markup function " (car arg)))
-        ((not (markup-argument-list? (markup-command-signature (car arg))
-                                     (cdr arg)))
-         (throw 'markup-format "Arguments failed  typecheck for " arg)))
-  #t)
-
-;;
-;; good enough if you only  use make-XXX-markup functions.
-;; 
-(define (cheap-markup? x)
-  (or (string? x)
-      (and (pair? x)
-           (markup-function? (car x)))))
-
-;;
-;; replace by markup-thrower-typecheck for more detailed diagnostics.
-;; 
-(define-public markup? cheap-markup?)
-
-;; utility
-
-(define (markup-join markups sep)
-  "Return line-markup of MARKUPS, joining them with markup SEP"
-  (if (pair? markups)
-      (make-line-markup (list-insert-separator markups sep))
-      empty-markup))
-
-(define-public brew-new-markup-stencil Text_interface::print)
-(define-public interpret-markup Text_interface::interpret_markup)
-(define-public (prepend-alist-chain key val chain)
-  (cons (acons key val (car chain)) (cdr chain)))
-
-
-
-
-(define-public (stack-stencil-line space stencils)
-  "DOCME"
-  (if (and (pair? stencils)
-	   (ly:stencil? (car stencils)))
-      
-      (if (and (pair? (cdr stencils))
-	       (ly:stencil? (cadr stencils)))
-          (let* ((tail (stack-stencil-line  space (cdr stencils)))
-                 (head (car stencils))
-                 (xoff (+ space (cdr (ly:stencil-extent head X)))))
-            (ly:stencil-add head
-                             (ly:stencil-translate-axis tail xoff X)))
-          (car stencils))
-      (ly:make-stencil '() '(0 . 0) '(0 . 0))))
-
-
-
-
-
-
-
diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index e4731f4647..fa3659f405 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -116,22 +116,14 @@
 	((symbol? arg) (string-append "\"" (symbol->string arg) "\""))))
 
 (define-public (print-circled-text-callback grob)
-  (let*
-      ((text (ly:grob-property grob 'text))
-       (layout (ly:grob-layout grob))
-       (defs (ly:output-def-lookup layout 'text-font-defaults))
-       (props (ly:grob-alist-chain grob defs))
-       (circle (Text_interface::interpret_markup layout props 
-						 (make-circle-markup
-						  0.8 0.1)))
-       (text-stencil
-	(Text_interface::interpret_markup layout props text)))
-
-    
-    (ly:stencil-add
-     (centered-stencil text-stencil)
-     circle)
-  ))
+  (let* ((text (ly:grob-property grob 'text))
+	 (layout (ly:grob-layout grob))
+	 (defs (ly:output-def-lookup layout 'text-font-defaults))
+	 (props (ly:grob-alist-chain grob defs))
+	 (circle (Text_interface::interpret_markup
+		  layout props (make-draw-circle-markup 0.8 0.1)))
+	 (text-stencil (Text_interface::interpret_markup layout props text)))
+    (ly:stencil-add (centered-stencil text-stencil) circle)))
 
 
 ;;(define (mm-to-pt x)
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 1d969d056d..51d6d968aa 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -109,21 +109,15 @@
     (list arch_angle arch_width arch_height height arch_thick thick))
    " draw_bracket"))
 
+(define (circle radius thick)
+  (format
+   "~a ~a draw_circle" radius thick))
+
 (define (char font i)
   (string-append 
    (ps-font-command font) " setfont " 
    "(\\" (ly:inexact->string i 8) ") show"))
 
-;; save current color on stack and set new color
-(define (setcolor r g b)
-  (string-append "currentrgbcolor "
-  (ly:numbers->string (list r g b))
-  " setrgbcolor\n"))
-
-;; restore color from stack
-(define (resetcolor)
-  (string-append "setrgbcolor\n"))
-
 (define (dashed-line thick on off dx dy)
   (string-append 
    (ly:number->string dx) " "
@@ -146,11 +140,6 @@
    (ly:number->string off)
    " ] 0 draw_dashed_slur"))
 
-(define (circle radius thick)
-  (format
-   "~a ~a draw_circle" radius thick))
-
-
 (define (dot x y radius)
   (string-append
    " "
@@ -183,10 +172,6 @@
   (string-append (ly:numbers->string (list breapth width depth height))
 		 " draw_box"))
 
-
-(define (utf8-string pango-font-description string)
-  (ly:warn "utf8-string encountered in PS backend"))
-
 (define (glyph-string
 	 postscript-font-name
 	 size
@@ -273,11 +258,21 @@
    (ly:numbers->string (list wid slope thick))
    " draw_repeat_slash"))
 
+;; restore color from stack
+(define (resetcolor)
+  (string-append "setrgbcolor\n"))
+
 (define (round-filled-box x y width height blotdiam)
   (string-append
    (ly:numbers->string
     (list x y width height blotdiam)) " draw_round_box"))
 
+;; save current color on stack and set new color
+(define (setcolor r g b)
+  (string-append "currentrgbcolor "
+  (ly:numbers->string (list r g b))
+  " setrgbcolor\n"))
+
 (define (text font s)
 ;  (ly:warn "TEXT backend-command encountered in Pango backend\nargs: ~a ~a" font str)
   
@@ -309,6 +304,9 @@
 	  (cdr y)
 	  url))
 
+(define (utf8-string pango-font-description string)
+  (ly:warn "utf8-string encountered in PS backend"))
+
 (define (white-dot x y radius)
   (string-append
    " "
diff --git a/scm/output-tex.scm b/scm/output-tex.scm
index d04e83d8d0..43e68d7782 100644
--- a/scm/output-tex.scm
+++ b/scm/output-tex.scm
@@ -24,6 +24,7 @@
   ;; JUNK this -- see lily.scm: ly:all-output-backend-commands
   #:export (unknown
 	    blank
+	    circle
 	    dot
 	    white-dot
 	    beam
@@ -72,16 +73,14 @@
 (define (url-link url x y)
   "")
 
-
 (define (blank)
   "")
 
-(define (dot x y radius)
-  (embedded-ps (list 'dot x y radius)))
-
 (define (circle radius thick)
   (embedded-ps (list 'circle radius thick)))
 
+(define (dot x y radius)
+  (embedded-ps (list 'dot x y radius)))
 
 (define (embedded-ps string)
   (embedded-ps (list 'embedded-ps string)))
diff --git a/scm/stencil.scm b/scm/stencil.scm
index aca5ce8852..70b65dce98 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -24,10 +24,7 @@
 
 (define-public (centered-stencil stencil)
   "Center stencil @var{stencil} in both the X and Y directions"
-
-  (ly:stencil-aligned-to
-   (ly:stencil-aligned-to stencil X CENTER)
-   Y CENTER))
+  (ly:stencil-aligned-to (ly:stencil-aligned-to stencil X CENTER) Y CENTER))
 
 (define-public (stack-lines dir padding baseline stils)
   "Stack vertically with a baseline-skip."
@@ -60,6 +57,13 @@
                        (- (car yext)) (cdr yext))
       xext yext))
 
+(define-public (make-circle-stencil radius thickness)
+  "Make a circle of radius @var{radius} and thickness @var{thickness}"
+  (ly:make-stencil
+   (list 'circle radius thickness)
+   (cons (- radius) radius)
+   (cons (- radius) radius)))
+
 (define-public (box-grob-stencil grob)
   "Make a box of exactly the extents of the grob.  The box precisely
 encloses the contents.
@@ -70,25 +74,33 @@ encloses the contents.
     
     (ly:stencil-add
      (make-filled-box-stencil xext (cons (- (car yext) thick) (car yext)))
-     (make-filled-box-stencil xext (cons  (cdr yext) (+ (cdr yext) thick)))
+     (make-filled-box-stencil xext (cons (cdr yext) (+ (cdr yext) thick)))
      (make-filled-box-stencil (cons (cdr xext) (+ (cdr xext) thick)) yext)
      (make-filled-box-stencil (cons (- (car xext) thick) (car xext)) yext))))
 
 ;; TODO merge this and prev function. 
-(define-public (box-stencil stil thick padding)
-  "Add a box around STIL, producing a new stencil."
-  (let* ((x-ext (interval-widen (ly:stencil-extent stil 0) padding))
-	 (y-ext (interval-widen (ly:stencil-extent stil 1) padding))
+(define-public (box-stencil stencil thick padding)
+  "Add a box around STENCIL, producing a new stencil."
+  (let* ((x-ext (interval-widen (ly:stencil-extent stencil 0) padding))
+	 (y-ext (interval-widen (ly:stencil-extent stencil 1) padding))
 	 (y-rule (make-filled-box-stencil (cons 0 thick) y-ext))
-	 (x-rule (make-filled-box-stencil (interval-widen x-ext thick)
-					   (cons 0 thick))))
-    
-    (set! stil (ly:stencil-combine-at-edge stil X 1 y-rule padding))
-    (set! stil (ly:stencil-combine-at-edge stil X -1 y-rule padding))
-    (set! stil (ly:stencil-combine-at-edge stil Y 1 x-rule 0.0))  
-    (set! stil (ly:stencil-combine-at-edge stil Y -1 x-rule 0.0))
-    
-    stil))
+	 (x-rule (make-filled-box-stencil
+		  (interval-widen x-ext thick) (cons 0 thick))))
+    (set! stencil (ly:stencil-combine-at-edge stencil X 1 y-rule padding))
+    (set! stencil (ly:stencil-combine-at-edge stencil X -1 y-rule padding))
+    (set! stencil (ly:stencil-combine-at-edge stencil Y 1 x-rule 0.0))  
+    (set! stencil (ly:stencil-combine-at-edge stencil Y -1 x-rule 0.0))
+    stencil))
+
+(define-public (circle-stencil stencil thickness padding)
+  "Add a circle around STENCIL, producing a new stencil."
+  (let* ((x-ext (ly:stencil-extent stencil 0))
+	 (y-ext (ly:stencil-extent stencil 1))
+	 (diameter (max (- (cdr x-ext) (car x-ext))
+			(- (cdr y-ext) (car y-ext))))
+	 (radius (+ (/ diameter 2) padding)))
+    (ly:stencil-add
+     (centered-stencil stencil) (make-circle-stencil radius thickness))))
 
 (define-public (fontify-text font-metric text)
   "Set TEXT with font FONT-METRIC, returning a stencil."