X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-markup-commands.scm;h=4844dcd75e321d60b5adec7849900bbfdf1be344;hb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;hp=fa98be0872a465a5a16cb96527ec03945abf1a52;hpb=2fa31a12ca8c7444ddb5aae5b26d4a2d956d8b1e;p=lilypond.git

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index fa98be0872..4844dcd75e 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2000--2012  Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2000--2015  Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -115,6 +115,31 @@
                                               empty-interval empty-interval))
 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; line has to come early since it is often used implicitly from the
+;; markup macro since \markup { a b c } -> \markup \line { a b c }
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-markup-command (line layout props args)
+  (markup-list?)
+  #:category align
+  #:properties ((word-space)
+                (text-direction RIGHT))
+  "Put @var{args} in a horizontal line.  The property @code{word-space}
+determines the space between markups in @var{args}.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\line {
+    one two three
+  }
+}
+@end lilypond"
+  (let ((stencils (interpret-markup-list layout props args)))
+    (if (= text-direction LEFT)
+        (set! stencils (reverse stencils)))
+    (stack-stencil-line word-space stencils)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; geometric shapes
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -568,12 +593,12 @@ thickness, and @code{offset} to determine line y-offset.
 @end lilypond"
   (let* ((thick (ly:output-def-lookup layout 'line-thickness))
          (underline-thick (* thickness thick))
-         (markup (interpret-markup layout props arg))
-         (x1 (car (ly:stencil-extent markup X)))
-         (x2 (cdr (ly:stencil-extent markup X)))
+         (m (interpret-markup layout props arg))
+         (x1 (car (ly:stencil-extent m X)))
+         (x2 (cdr (ly:stencil-extent m X)))
          (y (* thick (- offset)))
          (line (make-line-stencil underline-thick x1 y x2 y)))
-    (ly:stencil-add markup line)))
+    (ly:stencil-add m line)))
 
 (define-markup-command (box layout props arg)
   (markup?)
@@ -889,21 +914,11 @@ grestore
   "
 @cindex paths, drawing
 @cindex drawing paths
-Draws a path with line thickness @var{thickness} according to the
+Draws a path with line @var{thickness} according to the
 directions given in @var{commands}.  @var{commands} is a list of
 lists where the @code{car} of each sublist is a drawing command and
 the @code{cdr} comprises the associated arguments for each command.
 
-Line-cap styles and line-join styles may be customized by
-overriding the @code{line-cap-style} and @code{line-join-style}
-properties, respectively.  Available line-cap styles are
-@code{'butt}, @code{'round}, and @code{'square}.  Available
-line-join styles are @code{'miter}, @code{'round}, and
-@code{'bevel}.
-
-The property @code{filled} specifies whether or not the path is
-filled with color.
-
 There are seven commands available to use in the list
 @code{commands}: @code{moveto}, @code{rmoveto}, @code{lineto},
 @code{rlineto}, @code{curveto}, @code{rcurveto}, and
@@ -926,6 +941,16 @@ current subpath in the active path.
 Note that a sequence of commands @emph{must} begin with a
 @code{moveto} or @code{rmoveto} to work with the SVG output.
 
+Line-cap styles and line-join styles may be customized by
+overriding the @code{line-cap-style} and @code{line-join-style}
+properties, respectively.  Available line-cap styles are
+@code{'butt}, @code{'round}, and @code{'square}.  Available
+line-join styles are @code{'miter}, @code{'round}, and
+@code{'bevel}.
+
+The property @code{filled} specifies whether or not the path is
+filled with color.
+
 @lilypond[verbatim,quote]
 samplePath =
   #'((moveto 0 0)
@@ -937,6 +962,10 @@ samplePath =
 
 \\markup {
   \\path #0.25 #samplePath
+
+  \\override #'(line-join-style . miter) \\path #0.25 #samplePath
+
+  \\override #'(filled . #t) \\path #0.25 #samplePath
 }
 @end lilypond"
   (let* ((half-thickness (/ thickness 2))
@@ -1128,92 +1157,148 @@ the use of @code{\\simple} is unnecessary.
 @end lilypond"
   (interpret-markup layout props str))
 
-(define-markup-command (tied-lyric layout props str)
-  (string?)
-  #:category music
-  #:properties ((word-space))
-  "
-@cindex simple text strings with tie characters
-
-Like simple-markup, but use tie characters for @q{~} tilde symbols.
+(define-markup-command (first-visible layout props args)
+  (markup-list?)
+  #:category other
+  "Use the first markup in @var{args} that yields a non-empty stencil
+and ignore the rest.
 
 @lilypond[verbatim,quote]
-\\markup \\column {
-  \\tied-lyric #\"Siam navi~all'onde~algenti Lasciate~in abbandono\"
-  \\tied-lyric #\"Impetuosi venti I nostri~affetti sono\"
-  \\tied-lyric #\"Ogni diletto~e scoglio Tutta la vita~e~un mar.\"
+\\markup {
+  \\first-visible {
+    \\fromproperty #'header:composer
+    \\italic Unknown
+  }
 }
 @end lilypond"
-  (define (replace-ties tie str)
-    (if (string-contains str "~")
-        (let*
-            ((half-space (/ word-space 2))
-             (parts (string-split str #\~))
-             (tie-str (markup #:hspace half-space
-                              #:musicglyph tie
-                              #:hspace half-space))
-             (joined  (list-join parts tie-str)))
-          (make-concat-markup joined))
-        str))
-
-  (define short-tie-regexp (make-regexp "~[^.]~"))
-  (define (match-short str) (regexp-exec short-tie-regexp str))
-
-  (define (replace-short str mkp)
-    (let ((match (match-short str)))
-      (if (not match)
-          (make-concat-markup (list
-                               mkp
-                               (replace-ties "ties.lyric.default" str)))
-          (let ((new-str (match:suffix match))
-                (new-mkp (make-concat-markup (list
-                                              mkp
-                                              (replace-ties "ties.lyric.default"
-                                                            (match:prefix match))
-                                              (replace-ties "ties.lyric.short"
-                                                            (match:substring match))))))
-            (replace-short new-str new-mkp)))))
-
-  (interpret-markup layout
-                    props
-                    (replace-short str (markup))))
+  (define (false-if-empty stencil)
+    (if (ly:stencil-empty? stencil) #f stencil))
+  (or
+   (any
+    (lambda (m)
+      (if (markup? m)
+          (false-if-empty (interpret-markup layout props m))
+          (any false-if-empty (interpret-markup-list layout props (list m)))))
+    args)
+   empty-stencil))
 
 (define-public empty-markup
   (make-simple-markup ""))
 
 ;; helper for justifying lines.
-(define (get-fill-space word-count line-width word-space text-widths)
-  "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.
-  All paddings are checked to be at least word-space, to ensure that
-  no texts collide.
-  Return a list of paddings."
+(define (get-fill-space
+          word-count line-width word-space text-widths constant-space?)
+  "Calculate the necessary paddings between adjacent texts in a
+single justified line.  The lengths of all texts are stored in
+@var{text-widths}.
+When @var{constant-space?} is @code{#t}, the formula for the padding
+between texts is:
+padding = (line-width - total-text-width)/(word-count - 1)
+When @var{constant-space?} is @code{#f}, the formula for the
+padding between interior texts a and b is:
+padding = line-width/(word-count - 1) - (length(a) + length(b))/2
+In this case, the first and last padding have to be calculated
+specially using the whole length of the first or last text.
+All paddings are checked to be at least word-space, to ensure that
+no texts collide.
+Return a list of paddings."
   (cond
-   ((null? 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 word-space (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
-    (let ((default-padding
-            (- (/ line-width (1- word-count))
-               (/ (+ (car text-widths) (car (cdr text-widths))) 2))))
-      (cons
-       (if (> word-space default-padding)
-           word-space
-           default-padding)
-       (get-fill-space word-count line-width word-space (cdr text-widths)))))))
+    ((null? text-widths) '())
+    (constant-space?
+     (make-list
+       (1- word-count)
+       ;; Ensure that space between words cannot be
+       ;; less than word-space.
+       (max
+         word-space
+         (/ (- line-width (apply + text-widths))
+            (1- word-count)))))
+
+    ;; special case first padding
+    ((= (length text-widths) word-count)
+     (cons
+       (- (- (/ line-width (1- word-count)) (car text-widths))
+          (/ (cadr text-widths) 2))
+       (get-fill-space
+         word-count line-width word-space (cdr text-widths)
+                                          constant-space?)))
+    ;; special case last padding
+    ((= (length text-widths) 2)
+     (list (- (/ line-width (1- word-count))
+              (+ (/ (car text-widths) 2) (cadr text-widths)))
+           0))
+    (else
+      (let ((default-padding
+              (- (/ line-width (1- word-count))
+                 (/ (+ (car text-widths) (cadr text-widths)) 2))))
+        (cons
+          (if (> word-space default-padding)
+              word-space
+              default-padding)
+          (get-fill-space
+            word-count line-width word-space (cdr text-widths)
+                                             constant-space?))))))
+
+(define (justify-line-helper
+          layout props args text-direction word-space line-width constant-space?)
+  "Return a stencil which spreads @var{args} along a line of width
+@var{line-width}.  If @var{constant-space?} is set to @code{#t}, the
+space between words is constant.  If @code{#f}, the distance between
+words varies according to their relative lengths."
+  (let* ((orig-stencils (interpret-markup-list layout props args))
+         (stencils
+           (map (lambda (stc)
+                  (if (ly:stencil-empty? stc X)
+                      (ly:make-stencil (ly:stencil-expr stc)
+                                       '(0 . 0) (ly:stencil-extent stc Y))
+                      stc))
+                orig-stencils))
+         (text-widths
+           (map (lambda (stc)
+                  (interval-length (ly:stencil-extent stc X)))
+                stencils))
+         (text-width (apply + text-widths))
+         (word-count (length stencils))
+         (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
+         (fill-space
+           (cond
+             ((= word-count 1)
+              (list
+                (/ (- line-width text-width) 2)
+                (/ (- line-width text-width) 2)))
+             ((= word-count 2)
+              (list
+                (- line-width text-width)))
+             (else
+               (get-fill-space
+                 word-count line-width word-space text-widths
+                                                  constant-space?))))
+         (line-contents (if (= word-count 1)
+                            (list
+                              point-stencil
+                              (car stencils)
+                              point-stencil)
+                            stencils)))
+
+    (if (null? (remove ly:stencil-empty? orig-stencils))
+        empty-stencil
+        (begin
+          (if (= text-direction LEFT)
+              (set! line-contents (reverse line-contents)))
+          (set! line-contents
+                (stack-stencils-padding-list
+                  X RIGHT fill-space line-contents))
+          (if (> word-count 1)
+              ;; shift s.t. stencils align on the left edge, even if
+              ;; first stencil had negative X-extent (e.g. center-column)
+              ;; (if word-count = 1, X-extents are already normalized in
+              ;; the definition of line-contents)
+              (set! line-contents
+                    (ly:stencil-translate-axis
+                      line-contents
+                      (- (car (ly:stencil-extent (car stencils) X)))
+                      X)))
+          line-contents))))
 
 (define-markup-command (fill-line layout props args)
   (markup-list?)
@@ -1242,79 +1327,28 @@ If there are no arguments, return an empty stencil.
   }
 }
 @end lilypond"
-  (let* ((orig-stencils (interpret-markup-list layout props args))
-         (stencils
-          (map (lambda (stc)
-                 (if (ly:stencil-empty? stc)
-                     point-stencil
-                     stc)) orig-stencils))
-         (text-widths
-          (map (lambda (stc)
-                 (if (ly:stencil-empty? stc)
-                     0.0
-                     (interval-length (ly:stencil-extent stc X))))
-               stencils))
-         (text-width (apply + text-widths))
-         (word-count (length stencils))
-         (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
-         (fill-space
-          (cond
-           ((= word-count 1)
-            (list
-             (/ (- line-width text-width) 2)
-             (/ (- line-width text-width) 2)))
-           ((= word-count 2)
-            (list
-             (- line-width text-width)))
-           (else
-            (get-fill-space word-count line-width word-space text-widths))))
-
-         (line-contents (if (= word-count 1)
-                            (list
-                             point-stencil
-                             (car stencils)
-                             point-stencil)
-                            stencils)))
-
-    (if (null? (remove ly:stencil-empty? orig-stencils))
-        empty-stencil
-        (begin
-          (if (= text-direction LEFT)
-              (set! line-contents (reverse line-contents)))
-          (set! line-contents
-                (stack-stencils-padding-list
-                 X RIGHT fill-space line-contents))
-          (if (> word-count 1)
-              ;; shift s.t. stencils align on the left edge, even if
-              ;; first stencil had negative X-extent (e.g. center-column)
-              ;; (if word-count = 1, X-extents are already normalized in
-              ;; the definition of line-contents)
-              (set! line-contents
-                    (ly:stencil-translate-axis
-                     line-contents
-                     (- (car (ly:stencil-extent (car stencils) X)))
-                     X)))
-          line-contents))))
+  (justify-line-helper
+    layout props args text-direction word-space line-width #f))
 
-(define-markup-command (line layout props args)
+(define-markup-command (justify-line layout props args)
   (markup-list?)
   #:category align
-  #:properties ((word-space)
-                (text-direction RIGHT))
-  "Put @var{args} in a horizontal line.  The property @code{word-space}
-determines the space between markups in @var{args}.
+  #:properties ((text-direction RIGHT)
+                (word-space 0.6)
+                (line-width #f))
+  "Put @var{markups} in a horizontal line of width @var{line-width}.
+The markups are spread to fill the entire line and separated by equal
+space.  If there are no arguments, return an empty stencil.
 
 @lilypond[verbatim,quote]
 \\markup {
-  \\line {
-    one two three
+  \\justify-line {
+    Space between neighboring words is constant
   }
 }
 @end lilypond"
-  (let ((stencils (interpret-markup-list layout props args)))
-    (if (= text-direction LEFT)
-        (set! stencils (reverse stencils)))
-    (stack-stencil-line word-space stencils)))
+  (justify-line-helper
+    layout props args text-direction word-space line-width #t))
 
 (define-markup-command (concat layout props args)
   (markup-list?)
@@ -1365,8 +1399,8 @@ equivalent to @code{\"fi\"}.
   "Perform simple wordwrap, return stencil of each line."
   (define space (if justify
                     ;; justify only stretches lines.
-		    (* 0.7 base-space)
-		    base-space))
+                    (* 0.7 base-space)
+                    base-space))
   (define (stencil-len s)
     (interval-end (ly:stencil-extent s X)))
   (define (maybe-shift line)
@@ -2368,7 +2402,7 @@ may be any property supported by @rinternals{font-interface},
 (define-markup-command (abs-fontsize layout props size arg)
   (number? markup?)
   #:category font
-  "Use @var{size} as the absolute font size to display @var{arg}.
+  "Use @var{size} as the absolute font size (in points) to display @var{arg}.
 Adjusts @code{baseline-skip} and @code{word-space} accordingly.
 
 @lilypond[verbatim,quote]
@@ -2986,6 +3020,56 @@ Draw @var{arg} in color specified by @var{color}.
                      (ly:stencil-extent stil X)
                      (ly:stencil-extent stil Y))))
 
+(define-markup-command (tied-lyric layout props str)
+  (string?)
+  #:category music
+  #:properties ((word-space))
+  "
+@cindex simple text strings with tie characters
+
+Like simple-markup, but use tie characters for @q{~} tilde symbols.
+
+@lilypond[verbatim,quote]
+\\markup \\column {
+  \\tied-lyric #\"Siam navi~all'onde~algenti Lasciate~in abbandono\"
+  \\tied-lyric #\"Impetuosi venti I nostri~affetti sono\"
+  \\tied-lyric #\"Ogni diletto~e scoglio Tutta la vita~e~un mar.\"
+}
+@end lilypond"
+  (define (replace-ties tie str)
+    (if (string-contains str "~")
+        (let*
+            ((half-space (/ word-space 2))
+             (parts (string-split str #\~))
+             (tie-str (markup #:hspace half-space
+                              #:musicglyph tie
+                              #:hspace half-space))
+             (joined  (list-join parts tie-str)))
+          (make-concat-markup joined))
+        str))
+
+  (define short-tie-regexp (make-regexp "~[^.]~"))
+  (define (match-short str) (regexp-exec short-tie-regexp str))
+
+  (define (replace-short str mkp)
+    (let ((match (match-short str)))
+      (if (not match)
+          (make-concat-markup (list
+                               mkp
+                               (replace-ties "ties.lyric.default" str)))
+          (let ((new-str (match:suffix match))
+                (new-mkp (make-concat-markup (list
+                                              mkp
+                                              (replace-ties "ties.lyric.default"
+                                                            (match:prefix match))
+                                              (replace-ties "ties.lyric.short"
+                                                            (match:substring match))))))
+            (replace-short new-str new-mkp)))))
+
+  (interpret-markup layout
+                    props
+                    (replace-short str (markup))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; glyphs
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3825,7 +3909,7 @@ an inverted glyph.  Note that within music, one would usually use the
 @code{\\fermata} articulation instead of a markup.
 
 @lilypond[verbatim,quote]
- { c1^\\markup \\fermata d1_\\markup \\fermata }
+ { c''1^\\markup \\fermata d''1_\\markup \\fermata }
 
 \\markup { \\fermata \\override #`(direction . ,DOWN) \\fermata }
 @end lilypond
@@ -4146,7 +4230,7 @@ a column containing several lines of text.
   }
 }
 @end lilypond"
-  (let* ((markup (interpret-markup layout props arg))
+  (let* ((m (interpret-markup layout props arg))
          (scaled-width (* size width))
          (scaled-thickness
           (* (chain-assoc-get 'line-thickness props 0.1)
@@ -4156,7 +4240,7 @@ a column containing several lines of text.
                (* (/ 4 3.0) scaled-width)))
          (padding (chain-assoc-get 'padding props half-thickness)))
     (parenthesize-stencil
-     markup half-thickness scaled-width angularity padding)))
+     m half-thickness scaled-width angularity padding)))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4172,7 +4256,11 @@ a column containing several lines of text.
 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."
+when @var{label} is not found.
+
+(If the current book or bookpart is set to use roman numerals for page numbers,
+the reference will be formatted accordingly -- in which case the @var{gauge}'s
+width may require additional tweaking.)"
   (let* ((gauge-stencil (interpret-markup layout props gauge))
          (x-ext (ly:stencil-extent gauge-stencil X))
          (y-ext (ly:stencil-extent gauge-stencil Y)))
@@ -4185,7 +4273,10 @@ when @var{label} is not found."
                        (page-number (if (list? table)
                                         (assoc-get label table)
                                         #f))
-                       (page-markup (if page-number (format #f "~a" page-number) default))
+                       (number-type (ly:output-def-lookup layout 'page-number-type))
+                       (page-markup (if page-number
+                                        (number-format number-type page-number)
+                                        default))
                        (page-stencil (interpret-markup layout props page-markup))
                        (gap (- (interval-length x-ext)
                                (interval-length (ly:stencil-extent page-stencil X)))))