Issue 4656: Let concat-markup fold \char calls into surrounding strings

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

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 363977da9be00b291770bfaddf504749751bebfe..6aae0be7801c3a93c28ea9d6c9cf0bf1b9c054ba 100644 (file)
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -509,6 +509,16 @@ in the PDF backend.
 
     (ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil)))
 
+(define-public (book-first-page layout props)
+  "Return the @code{'first-page-number} of the entire book"
+  (define (ancestor layout)
+    "Return the topmost layout ancestor"
+    (let ((parent (ly:output-def-parent layout)))
+      (if (not (ly:output-def? parent))
+          layout
+          (ancestor parent))))
+  (ly:output-def-lookup (ancestor layout) 'first-page-number))
+
 (define-markup-command (with-link layout props label arg)
   (symbol? markup?)
   #:category other
@@ -536,8 +546,7 @@ only works in the PDF backend.
                           (if (list? table)
                               (assoc-get label table)
                               #f))
-                        (first-page-number
-                          (ly:output-def-lookup layout 'first-page-number))
+                        (first-page-number (book-first-page layout props))
                         (current-page-number
                           (if table-page-number
                               (1+ (- table-page-number first-page-number))
@@ -713,40 +722,36 @@ Rotate object with @var{ang} degrees around its center.
 (define-markup-command (whiteout layout props arg)
   (markup?)
   #:category other
-  #:properties ((thickness 3))
+  #:properties ((style 'box)
+                (thickness '()))
   "
 @cindex adding a white background to text
 
-Provide a white background for @var{arg}.
+Provide a white background for @var{arg}.  The shape of the white
+background is determined by @code{style}.  The default
+is @code{box} which produces a white rectangle.  @code{outline}
+approximates the outline of the markup.
 
 @lilypond[verbatim,quote]
 \\markup {
   \\combine
-    \\filled-box #'(-1 . 10) #'(-3 . 4) #1
-    \\override #'(thickness . 1.5) \\whiteout whiteout
+    \\filled-box #'(-1 . 15) #'(-3 . 4) #1
+    \\override #'(thickness . 1.5)
+    \\whiteout whiteout-box
 }
-@end lilypond"
-  (stencil-whiteout
-    (interpret-markup layout props arg)
-      (* thickness
-        (ly:output-def-lookup layout 'line-thickness))))
-  
-(define-markup-command (whiteout-box layout props arg)
-  (markup?)
-  #:category other
-  "
-@cindex adding a rounded rectangular white background to text
-
-Provide a rounded rectangular white background for @var{arg}.
-
-@lilypond[verbatim,quote]
 \\markup {
   \\combine
-    \\filled-box #'(-1 . 10) #'(-3 . 4) #1
-    \\whiteout-box whiteout-box
+    \\filled-box #'(-1 . 18) #'(-3 . 4) #1
+    \\override #'(style . outline)
+    \\override #'(thickness . 3)
+    \\whiteout whiteout-outline
 }
 @end lilypond"
-  (stencil-whiteout-box (interpret-markup layout props arg)))
+  (stencil-whiteout
+    (interpret-markup layout props arg)
+    style
+    thickness
+    (ly:output-def-lookup layout 'line-thickness)))
 
 (define-markup-command (pad-markup layout props amount arg)
   (number? markup?)
@@ -1400,11 +1405,13 @@ equivalent to @code{\"fi\"}.
 @end lilypond"
   (define (concat-string-args arg-list)
     (fold-right (lambda (arg result-list)
-                  (let ((result (if (pair? result-list)
-                                    (car result-list)
-                                    '())))
-                    (if (and (pair? arg) (eqv? (car arg) simple-markup))
-                        (set! arg (cadr arg)))
+                  (let ((result (and (pair? result-list)
+                                     (car result-list))))
+                    (cond ((not (pair? arg)))
+                          ((eq? (car arg) simple-markup)
+                           (set! arg (cadr arg)))
+                          ((eq? (car arg) char-markup)
+                           (set! arg (ly:wide-char->utf-8 (cadr arg)))))
                     (if (and (string? result) (string? arg))
                         (cons (string-append arg result) (cdr result-list))
                         (cons arg result-list))))
@@ -1727,11 +1734,7 @@ the line width, where @var{X} is the number of staff spaces.
 Print two markups on top of each other.
 
 Note: @code{\\combine} cannot take a list of markups enclosed in
-curly braces as an argument; the follow example will not compile:
-
-@example
-\\combine @{ a list @}
-@end example
+curly braces as an argument; for this purpose use @code{\\overlay} instead.
 
 @lilypond[verbatim,quote]
 \\markup {
@@ -1746,6 +1749,27 @@ curly braces as an argument; the follow example will not compile:
          (s2 (interpret-markup layout props arg2)))
     (ly:stencil-add s1 s2)))
 
+(define-markup-command (overlay layout props args)
+  (markup-list?)
+  #:category align
+  "
+@cindex merging text
+
+Takes a list of markups combining them.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\fontsize #5
+  \\override #'(thickness . 2)
+  \\overlay {
+    \\draw-line #'(0 . 4)
+    \\arrow-head #Y #DOWN ##f
+    \\translate #'(0 . 4)\\arrow-head #Y #UP ##f
+  }
+}
+@end lilypond"
+  (apply ly:stencil-add (interpret-markup-list layout props args)))
+
 ;;
 ;; TODO: should extract baseline-skip from each argument somehow..
 ;;
@@ -3504,7 +3528,8 @@ Supported flag-styles are @code{default}, @code{old-straight-flag},
            (flag-stencil (buildflags stencil (- log 3) stencil spacing)))
       flag-stencil))
 
-  (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
+  (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)
+                                                 (font-name . #f))
                                                props)))
          (size-factor (magstep font-size))
          (blot (ly:output-def-lookup layout 'blot-diameter))
@@ -3720,7 +3745,9 @@ A rest or multi-measure-rest symbol.
 
   (let* ((font
           (ly:paper-get-font layout
-                             (cons '((font-encoding . fetaMusic)) props)))
+                             (cons '((font-encoding . fetaMusic)
+                                     (font-name . #f))
+                                   props)))
          (rest-glyph-name
           (let ((result
                  (get-glyph-name font