Merge branch 'master' of ssh+git://hanwen@git.sv.gnu.org/srv/git/lilypond

[lilypond.git] / scm / define-markup-commands.scm

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 0c23290b485eed371724428aba52ecb6a30ca252..4cffe4c248279435865597612bd2bc979c73a5d7 100644 (file)
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -30,16 +30,17 @@
   (let*
       ((th (chain-assoc-get 'thickness props  0.1))
        (x (car dest))
-       (y (cdr dest)))
+       (y (cdr dest))
+       (s (ly:make-stencil
+          `(draw-line
+            ,th
+            0 0
+            ,x ,y)
 
-    (ly:make-stencil
-     `(draw-line
-       ,th
-       0 0
-       ,x ,y)
+          (cons (min x 0) (max x 0))
+          (cons (min y 0) (max y 0)))))
 
-     (cons (min x 0) (min y 0))
-     (cons (max x 0) (max y 0)))))
+    s))
 
 (define-builtin-markup-command (draw-circle layout props radius thickness fill)
   (number? number? boolean?)
@@ -592,7 +593,7 @@ the line width, where @var{X} is the number of staff spaces."
 
 
 (define-builtin-markup-command (wordwrap-field layout props symbol) (symbol?)
-  "Wordwrap the data which has been assigned to @var{symbol}.
+  "Wordwrap the data which has been assigned to @var{symbol}."
   (let* ((m (chain-assoc-get symbol props)))
     (if (string? m)
      (interpret-markup layout props
@@ -600,7 +601,7 @@ the line width, where @var{X} is the number of staff spaces."
      (ly:make-stencil '()  '(1 . -1) '(1 . -1)))))
 
 (define-builtin-markup-command (justify-field layout props symbol) (symbol?)
-  "Justify the data which has been assigned to @var{symbol}.
+  "Justify the data which has been assigned to @var{symbol}."
   (let* ((m (chain-assoc-get symbol props)))
     (if (string? m)
      (interpret-markup layout props
@@ -1404,9 +1405,9 @@ and/or @code{extra-offset} properties."
 
 Raising and lowering texts can be done with @code{\\super} and
 @code{\\sub}:
-
+@c
 @lilypond[verbatim,fragment,relative=1]
-c1^\\markup { E \"=\" \\concat { "mc" \\super \"2\" } }
+c1^\\markup { E \"=\" \\concat { \"mc\" \\super \"2\" } }
 @end lilypond"
   (ly:stencil-translate-axis
    (interpret-markup
@@ -1463,8 +1464,30 @@ that."
         (m (interpret-markup layout props arg)))
     (bracketify-stencil m Y th (* 2.5 th) th)))
 \f
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; size indications arrow
+;; Delayed markup evaluation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define-builtin-markup-command (page-ref layout props label gauge default)
+  (symbol? markup? markup?)
+  "Reference to a page number. @var{label} is the label set on the referenced
+page (using the @code{\\label} command), @var{gauge} a markup used to estimate
+the maximum width of the page number, and @var{default} the value to display
+when @var{label} is not found."
+  (let* ((gauge-stencil (interpret-markup layout props gauge))
+        (x-ext (ly:stencil-extent gauge-stencil X))
+        (y-ext (ly:stencil-extent gauge-stencil Y)))
+    (ly:make-stencil
+     `(delay-stencil-evaluation
+       ,(delay (ly:stencil-expr
+               (let* ((table (ly:output-def-lookup layout 'label-page-table))
+                      (label-page (and (list? table) (assoc label table)))
+                      (page-number (and label-page (cdr label-page)))
+                      (page-markup (if page-number (format "~a" page-number) default))
+                      (page-stencil (interpret-markup layout props page-markup))
+                      (gap (- (interval-length x-ext)
+                              (interval-length (ly:stencil-extent page-stencil X)))))
+                 (interpret-markup layout props
+                                   (markup #:concat (#:hspace gap page-markup)))))))
+     x-ext
+     y-ext)))