scm/define-markup-commands.scm

   1 ;;;; define-markup-commands.scm -- markup commands
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2000--2007  Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8
   9 ;;; markup commands
  10 ;;;  * each markup function should have a doc string with
  11 ;;     syntax, description and example.
  12
  13 (use-modules (ice-9 regex))
  14
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;; utility functions
  17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18
  19 (define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
  20 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
  21
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;; geometric shapes
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25
  26 (define-builtin-markup-command (draw-line layout props dest)
  27   (number-pair?)
  28   graphic
  29   ((thickness 1))
  30   "
  31 @cindex drawing lines within text
  32
  33 A simple line.
  34 @lilypond[verbatim,quote]
  35 \\markup {
  36   \\draw-line #'(4 . 4)
  37   \\override #'(thickness . 5)
  38   \\draw-line #'(-3 . 0)
  39 }
  40 @end lilypond"
  41   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
  42                thickness))
  43         (x (car dest))
  44         (y (cdr dest)))
  45     (ly:make-stencil
  46      `(draw-line
  47        ,th
  48        0 0
  49        ,x ,y)
  50      (cons (min x 0) (max x 0))
  51      (cons (min y 0) (max y 0)))))
  52
  53 (define-builtin-markup-command (draw-circle layout props radius thickness fill)
  54   (number? number? boolean?)
  55   graphic
  56   ()
  57   "
  58 @cindex drawing circles within text
  59
  60 A circle of radius @var{radius}, thickness @var{thickness} and
  61 optionally filled.
  62
  63 @lilypond[verbatim,quote]
  64 \\markup {
  65   \\draw-circle #2 #0.5 ##f
  66   \\hspace #2
  67   \\draw-circle #2 #0 ##t
  68 }
  69 @end lilypond"
  70   (make-circle-stencil radius thickness fill))
  71
  72 (define-builtin-markup-command (triangle layout props filled)
  73   (boolean?)
  74   graphic
  75   ((thickness 0.1)
  76    (font-size 0)
  77    (baseline-skip 2))
  78   "
  79 @cindex drawing triangles within text
  80
  81 A triangle, either filled or empty.
  82
  83 @lilypond[verbatim,quote]
  84 \\markup {
  85   \\triangle ##t
  86   \\hspace #2
  87   \\triangle ##f
  88 }
  89 @end lilypond"
  90   (let ((ex (* (magstep font-size) 0.8 baseline-skip)))
  91     (ly:make-stencil
  92      `(polygon '(0.0 0.0
  93                      ,ex 0.0
  94                      ,(* 0.5 ex)
  95                      ,(* 0.86 ex))
  96            ,thickness
  97            ,filled)
  98      (cons 0 ex)
  99      (cons 0 (* .86 ex)))))
 100
 101 (define-builtin-markup-command (circle layout props arg)
 102   (markup?)
 103   graphic
 104   ((thickness 1)
 105    (font-size 0)
 106    (circle-padding 0.2))
 107   "
 108 @cindex circling text
 109
 110 Draw a circle around @var{arg}.  Use @code{thickness},
 111 @code{circle-padding} and @code{font-size} properties to determine line
 112 thickness and padding around the markup.
 113
 114 @lilypond[verbatim,quote]
 115 \\markup {
 116   \\circle {
 117     Hi
 118   }
 119 }
 120 @end lilypond"
 121   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 122                thickness))
 123          (pad (* (magstep font-size) circle-padding))
 124          (m (interpret-markup layout props arg)))
 125     (circle-stencil m th pad)))
 126
 127 (define-builtin-markup-command (with-url layout props url arg)
 128   (string? markup?)
 129   graphic
 130   ()
 131   "
 132 @cindex inserting URL links into text
 133
 134 Add a link to URL @var{url} around @var{arg}.  This only works in
 135 the PDF backend.
 136
 137 @lilypond[verbatim,quote]
 138 \\markup {
 139   \\with-url #\"http://lilypond.org/web/\" {
 140     LilyPond ... \\italic {
 141       music notation for everyone
 142     }
 143   }
 144 }
 145 @end lilypond"
 146   (let* ((stil (interpret-markup layout props arg))
 147          (xextent (ly:stencil-extent stil X))
 148          (yextent (ly:stencil-extent stil Y))
 149          (old-expr (ly:stencil-expr stil))
 150          (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
 151
 152     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
 153
 154 (define-builtin-markup-command (beam layout props width slope thickness)
 155   (number? number? number?)
 156   graphic
 157   ()
 158   "
 159 @cindex drawing beams within text
 160
 161 Create a beam with the specified parameters.
 162 @lilypond[verbatim,quote]
 163 \\markup {
 164   \\beam #5 #1 #2
 165 }
 166 @end lilypond"
 167   (let* ((y (* slope width))
 168          (yext (cons (min 0 y) (max 0 y)))
 169          (half (/ thickness 2)))
 170
 171     (ly:make-stencil
 172      `(polygon ',(list
 173                   0 (/ thickness -2)
 174                     width (+ (* width slope)  (/ thickness -2))
 175                     width (+ (* width slope)  (/ thickness 2))
 176                     0 (/ thickness 2))
 177                ,(ly:output-def-lookup layout 'blot-diameter)
 178                #t)
 179      (cons 0 width)
 180      (cons (+ (- half) (car yext))
 181            (+ half (cdr yext))))))
 182
 183 (define-builtin-markup-command (underline layout props arg)
 184   (markup?)
 185   font
 186   ((thickness 1))
 187   "
 188 @cindex underlining text
 189
 190 Underline @var{arg}.  Looks at @code{thickness} to determine line
 191 thickness and y offset.
 192
 193 @lilypond[verbatim,quote]
 194 \\markup {
 195   default
 196   \\hspace #2
 197   \\override #'(thickness . 2)
 198   \\underline {
 199     underline
 200   }
 201 }
 202 @end lilypond"
 203   (let* ((thick (* (ly:output-def-lookup layout 'line-thickness)
 204                    thickness))
 205          (markup (interpret-markup layout props arg))
 206          (x1 (car (ly:stencil-extent markup X)))
 207          (x2 (cdr (ly:stencil-extent markup X)))
 208          (y (* thick -2))
 209          (line (ly:make-stencil
 210                 `(draw-line ,thick ,x1 ,y ,x2 ,y)
 211                 (cons (min x1 0) (max x2 0))
 212                 (cons thick thick))))
 213     (ly:stencil-add markup line)))
 214
 215 (define-builtin-markup-command (box layout props arg)
 216   (markup?)
 217   font
 218   ((thickness 1)
 219    (font-size 0)
 220    (box-padding 0.2))
 221   "
 222 @cindex enclosing text within a box
 223
 224 Draw a box round @var{arg}.  Looks at @code{thickness},
 225 @code{box-padding} and @code{font-size} properties to determine line
 226 thickness and padding around the markup.
 227
 228 @lilypond[verbatim,quote]
 229 \\markup {
 230   \\override #'(box-padding . 0.5)
 231   \\box
 232   \\line { V. S. }
 233 }
 234 @end lilypond"
 235   (let* ((th (* (ly:output-def-lookup layout 'line-thickness)
 236                 thickness))
 237          (pad (* (magstep font-size) box-padding))
 238          (m (interpret-markup layout props arg)))
 239     (box-stencil m th pad)))
 240
 241 (define-builtin-markup-command (filled-box layout props xext yext blot)
 242   (number-pair? number-pair? number?)
 243   graphic
 244   ()
 245   "
 246 @cindex drawing solid boxes within text
 247 @cindex drawing boxes with rounded corners
 248
 249 Draw a box with rounded corners of dimensions @var{xext} and
 250 @var{yext}.  For example,
 251 @verbatim
 252 \\filled-box #'(-.3 . 1.8) #'(-.3 . 1.8) #0
 253 @end verbatim
 254 creates a box extending horizontally from -0.3 to 1.8 and
 255 vertically from -0.3 up to 1.8, with corners formed from a
 256 circle of diameter@tie{}0 (i.e. sharp corners).
 257
 258 @lilypond[verbatim,quote]
 259 \\markup {
 260   \\filled-box #'(0 . 4) #'(0 . 4) #0
 261   \\filled-box #'(0 . 2) #'(-4 . 2) #0.4
 262   \\filled-box #'(1 . 8) #'(0 . 7) #0.2
 263   \\with-color #white
 264   \\filled-box #'(-4.5 . -2.5) #'(3.5 . 5.5) #0.7
 265 }
 266 @end lilypond"
 267   (ly:round-filled-box
 268    xext yext blot))
 269
 270 (define-builtin-markup-command (rounded-box layout props arg)
 271   (markup?)
 272   graphic
 273   ((thickness 1)
 274    (corner-radius 1)
 275    (font-size 0)
 276    (box-padding 0.5))
 277   "@cindex enclosing text in a bow with rounded corners
 278    @cindex drawing boxes with rounded corners around text
 279 Draw a box with rounded corners around @var{arg}.  Looks at @code{thickness},
 280 @code{box-padding} and @code{font-size} properties to determine line
 281 thickness and padding around the markup; the @code{corner-radius} property
 282 makes possible to define another shape for the corners (default is 1).
 283
 284 @lilypond[quote,verbatim,fragment,relative=2]
 285 c4^\\markup {
 286   \\rounded-box {
 287     Overtura
 288   }
 289 }
 290 c,8. c16 c4 r
 291 @end lilypond"
 292   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 293                thickness))
 294         (pad (* (magstep font-size) box-padding))
 295         (m (interpret-markup layout props arg)))
 296     (ly:stencil-add (rounded-box-stencil m th pad corner-radius)
 297                     m)))
 298
 299 (define-builtin-markup-command (rotate layout props ang arg)
 300   (number? markup?)
 301   align
 302   ()
 303   "
 304 @cindex rotating text
 305
 306 Rotate object with @var{ang} degrees around its center.
 307
 308 @lilypond[verbatim,quote]
 309 \\markup {
 310   default
 311   \\hspace #2
 312   \\rotate #45
 313   \\line {
 314     rotated 45°
 315   }
 316 }
 317 @end lilypond"
 318   (let* ((stil (interpret-markup layout props arg)))
 319     (ly:stencil-rotate stil ang 0 0)))
 320
 321 (define-builtin-markup-command (whiteout layout props arg)
 322   (markup?)
 323   other
 324   ()
 325   "
 326 @cindex adding a white background to text
 327
 328 Provide a white background for @var{arg}.
 329
 330 @lilypond[verbatim,quote]
 331 \\markup {
 332   \\combine
 333   \\filled-box #'(-1 . 10) #'(-3 . 4) #1
 334   \\whiteout
 335   whiteout
 336 }
 337 @end lilypond"
 338   (stencil-whiteout (interpret-markup layout props arg)))
 339
 340 (define-builtin-markup-command (pad-markup layout props padding arg)
 341   (number? markup?)
 342   align
 343   ()
 344   "
 345 @cindex padding text
 346 @cindex putting space around text
 347
 348 Add space around a markup object."
 349   (let*
 350       ((stil (interpret-markup layout props arg))
 351        (xext (ly:stencil-extent stil X))
 352        (yext (ly:stencil-extent stil Y)))
 353
 354     (ly:make-stencil
 355      (ly:stencil-expr stil)
 356      (interval-widen xext padding)
 357      (interval-widen yext padding))))
 358
 359 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 360 ;; space
 361 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 362
 363 (define-builtin-markup-command (strut layout props)
 364   ()
 365   other
 366   ()
 367   "
 368 @cindex creating vertical spaces in text
 369
 370 Create a box of the same height as the space in the current font."
 371   (let ((m (ly:text-interface::interpret-markup layout props " ")))
 372     (ly:make-stencil (ly:stencil-expr m)
 373                      '(0 . 0)
 374                      (ly:stencil-extent m X)
 375                      )))
 376
 377 ;; todo: fix negative space
 378 (define-builtin-markup-command (hspace layout props amount)
 379   (number?)
 380   align
 381   ()
 382   "
 383 @cindex creating horizontal spaces in text
 384
 385 This produces an invisible object taking horizontal space.  For example,
 386
 387 @example
 388 \\markup @{ A \\hspace #2.0 B @}
 389 @end example
 390
 391 @noindent
 392 puts extra space between A and@tie{}B, on top of the space that is
 393 normally inserted before elements on a line.
 394
 395 @lilypond[verbatim,quote]
 396 \\markup {
 397   one
 398   \\hspace #2
 399   two
 400   \\hspace #8
 401   three
 402 }
 403 @end lilypond"
 404   (if (> amount 0)
 405       (ly:make-stencil "" (cons 0 amount) '(-1 . 1))
 406       (ly:make-stencil "" (cons amount amount) '(-1 . 1))))
 407
 408
 409 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 410 ;; importing graphics.
 411 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 412
 413 (define-builtin-markup-command (stencil layout props stil)
 414   (ly:stencil?)
 415   other
 416   ()
 417   "
 418 @cindex importing stencils into text
 419
 420 Use a stencil as markup.
 421
 422 @c FIXME works in .ly file, produces empty stencil in docs
 423 @lilypond[verbatim,quote]
 424 \\markup {
 425   \\stencil #(dimension-arrows '(15 . 0))
 426 }
 427 @end lilypond"
 428   stil)
 429
 430 (define bbox-regexp
 431   (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
 432
 433 (define (get-postscript-bbox string)
 434   "Extract the bbox from STRING, or return #f if not present."
 435   (let*
 436       ((match (regexp-exec bbox-regexp string)))
 437
 438     (if match
 439         (map (lambda (x)
 440                (string->number (match:substring match x)))
 441              (cdr (iota 5)))
 442
 443         #f)))
 444
 445 (define-builtin-markup-command (epsfile layout props axis size file-name)
 446   (number? number? string?)
 447   graphic
 448   ()
 449   "
 450 @cindex inlining an Encapsulated PostScript image
 451
 452 Inline an EPS image.  The image is scaled along @var{axis} to
 453 @var{size}.
 454
 455 @lilypond[verbatim,quote]
 456 \\markup {
 457   \\general-align #Y #DOWN {
 458     \\epsfile #X #20 #\"context-example.eps\"
 459     \\epsfile #Y #20 #\"context-example.eps\"
 460   }
 461 }
 462 @end lilypond"
 463   (if (ly:get-option 'safe)
 464       (interpret-markup layout props "not allowed in safe")
 465       (eps-file->stencil axis size file-name)
 466       ))
 467
 468 (define-builtin-markup-command (postscript layout props str)
 469   (string?)
 470   graphic
 471   ()
 472   "
 473 @cindex inserting PostScript directly into text
 474
 475 This inserts @var{str} directly into the output as a PostScript
 476 command string.  Due to technicalities of the output backends,
 477 different scales should be used for the @TeX{} and PostScript backend,
 478 selected with @code{-f}.
 479
 480 For the @TeX{} backend, the following string prints a rotated text
 481
 482 @example
 483 0 0 moveto /ecrm10 findfont
 484 1.75 scalefont setfont 90 rotate (hello) show
 485 @end example
 486
 487 @noindent
 488 The magical constant 1.75 scales from LilyPond units (staff spaces) to
 489 @TeX{} dimensions.
 490
 491 For the postscript backend, use the following
 492
 493 @example
 494 gsave /ecrm10 findfont
 495  10.0 output-scale div
 496  scalefont setfont 90 rotate (hello) show grestore
 497 @end example
 498
 499 @lilypond[verbatim,quote]
 500 eyeglassesps = #\"
 501   0.15 setlinewidth
 502   -0.9 0 translate
 503   1.1 1.1 scale
 504   1.2 0.7 moveto
 505   0.7 0.7 0.5 0 361 arc
 506   stroke
 507   2.20 0.70 0.50 0 361 arc
 508   stroke
 509   1.45 0.85 0.30 0 180 arc
 510   stroke
 511   0.20 0.70 moveto
 512   0.80 2.00 lineto
 513   0.92 2.26 1.30 2.40 1.15 1.70 curveto
 514   stroke
 515   2.70 0.70 moveto
 516   3.30 2.00 lineto
 517   3.42 2.26 3.80 2.40 3.65 1.70 curveto
 518   stroke\"
 519
 520 eyeglasses = \\markup {
 521   \\with-dimensions #'(0 . 4.4) #'(0 . 2.5)
 522   \\postscript #eyeglassesps
 523 }
 524
 525 \\relative c'' {
 526   c2^\\eyeglasses
 527   a2_\\eyeglasses
 528 }
 529 @end lilypond"
 530   ;; FIXME
 531   (ly:make-stencil
 532    (list 'embedded-ps
 533          (format "
 534 gsave currentpoint translate
 535 0.1 setlinewidth
 536  ~a
 537 grestore
 538 "
 539                  str))
 540    '(0 . 0) '(0 . 0)))
 541
 542 (define-builtin-markup-command (score layout props score)
 543   (ly:score?)
 544   music
 545   ()
 546   "
 547 @cindex inserting music into text
 548
 549 Inline an image of music.
 550
 551 @lilypond[verbatim,quote]
 552 \\markup {
 553   \\score {
 554     \\new PianoStaff <<
 555       \\new Staff \\relative c' {
 556         \\key f \\major
 557         \\time 3/4
 558         \\mark \\markup { Allegro }
 559         f2\\p( a4)
 560         c2( a4)
 561         bes2( g'4)
 562         f8( e) e4 r
 563       }
 564       \\new Staff \\relative c {
 565         \\clef bass
 566         \\key f \\major
 567         \\time 3/4
 568         f8( a c a c a
 569         f c' es c es c)
 570         f,( bes d bes d bes)
 571         f( g bes g bes g)
 572       }
 573     >>
 574     \\layout {
 575       indent = 0.0\\cm
 576       \\context {
 577         \\Score
 578         \\override RehearsalMark #'break-align-symbols =
 579           #'(time-signature key-signature)
 580         \\override RehearsalMark #'self-alignment-X = #LEFT
 581       }
 582       \\context {
 583         \\Staff
 584         \\override TimeSignature #'break-align-anchor-alignment = #LEFT
 585       }
 586     }
 587   }
 588 }
 589 @end lilypond"
 590   (let* ((output (ly:score-embedded-format score layout)))
 591
 592     (if (ly:music-output? output)
 593         (paper-system-stencil
 594          (vector-ref (ly:paper-score-paper-systems output) 0))
 595         (begin
 596           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
 597           empty-stencil))))
 598
 599 (define-builtin-markup-command (null layout props)
 600   ()
 601   other
 602   ()
 603   "
 604 @cindex creating empty text objects
 605
 606 An empty markup with extents of a single point.
 607
 608 @lilypond[verbatim,quote]
 609 \\markup {
 610   \\null
 611 }
 612 @end lilypond"
 613   point-stencil)
 614
 615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 616 ;; basic formatting.
 617 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 618
 619 (define-builtin-markup-command (simple layout props str)
 620   (string?)
 621   font
 622   ()
 623   "
 624 @cindex simple text strings
 625
 626 A simple text string; @code{\\markup @{ foo @}} is equivalent with
 627 @code{\\markup @{ \\simple #\"foo\" @}}.
 628
 629 @lilypond[verbatim,quote]
 630 \\markup {
 631   \\simple #\"simple\"
 632   \\simple #\"text\"
 633   \\simple #\"strings\"
 634 }
 635 @end lilypond"
 636   (interpret-markup layout props str))
 637
 638 (define-builtin-markup-command (tied-lyric layout props str)
 639   (string?)
 640   music
 641   ()
 642   "
 643 @cindex simple text strings with tie characters
 644
 645 Like simple-markup, but use tie characters for @q{~} tilde symbols.
 646
 647 @lilypond[verbatim,quote]
 648 \\markup {
 649   \\tied-lyric #\"Lasciate~i monti\"
 650 }
 651 @end lilypond"
 652   (if (string-contains str "~")
 653       (let*
 654           ((parts (string-split str #\~))
 655            (tie-str (ly:wide-char->utf-8 #x203f))
 656            (joined  (list-join parts tie-str))
 657            (join-stencil (interpret-markup layout props tie-str))
 658            )
 659
 660         (interpret-markup layout
 661                           (prepend-alist-chain
 662                            'word-space
 663                            (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
 664                            props)
 665                           (make-line-markup joined)))
 666                            ;(map (lambda (s) (interpret-markup layout props s)) parts))
 667       (interpret-markup layout props str)))
 668
 669 (define-public empty-markup
 670   (make-simple-markup ""))
 671
 672 ;; helper for justifying lines.
 673 (define (get-fill-space word-count line-width text-widths)
 674   "Calculate the necessary paddings between each two adjacent texts.
 675         The lengths of all texts are stored in @var{text-widths}.
 676         The normal formula for the padding between texts a and b is:
 677         padding = line-width/(word-count - 1) - (length(a) + length(b))/2
 678         The first and last padding have to be calculated specially using the
 679         whole length of the first or last text.
 680         Return a list of paddings."
 681   (cond
 682    ((null? text-widths) '())
 683
 684    ;; special case first padding
 685    ((= (length text-widths) word-count)
 686     (cons
 687      (- (- (/ line-width (1- word-count)) (car text-widths))
 688         (/ (car (cdr text-widths)) 2))
 689      (get-fill-space word-count line-width (cdr text-widths))))
 690    ;; special case last padding
 691    ((= (length text-widths) 2)
 692     (list (- (/ line-width (1- word-count))
 693              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
 694    (else
 695     (cons
 696      (- (/ line-width (1- word-count))
 697         (/ (+ (car text-widths) (car (cdr text-widths))) 2))
 698      (get-fill-space word-count line-width (cdr text-widths))))))
 699
 700 (define-builtin-markup-command (fill-line layout props markups)
 701   (markup-list?)
 702   align
 703   ((text-direction RIGHT)
 704    (word-space 1)
 705    (line-width #f))
 706   "Put @var{markups} in a horizontal line of width @var{line-width}.
 707 The markups are spaced or flushed to fill the entire line.
 708 If there are no arguments, return an empty stencil.
 709
 710 @lilypond[verbatim,quote]
 711 \\markup {
 712   \\column {
 713     \\fill-line {
 714       Words evenly spaced across the page
 715     }
 716     \\null
 717     \\fill-line {
 718       \\line { Text markups }
 719       \\line {
 720         \\italic { evenly spaced }
 721       }
 722       \\line { across the page }
 723     }
 724   }
 725 }
 726 @end lilypond"
 727   (let* ((orig-stencils (interpret-markup-list layout props markups))
 728          (stencils
 729           (map (lambda (stc)
 730                  (if (ly:stencil-empty? stc)
 731                      point-stencil
 732                      stc)) orig-stencils))
 733          (text-widths
 734           (map (lambda (stc)
 735                  (if (ly:stencil-empty? stc)
 736                      0.0
 737                      (interval-length (ly:stencil-extent stc X))))
 738                stencils))
 739          (text-width (apply + text-widths))
 740          (word-count (length stencils))
 741          (prop-line-width (chain-assoc-get 'line-width props #f))
 742          (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
 743          (fill-space
 744                 (cond
 745                         ((= word-count 1)
 746                                 (list
 747                                         (/ (- line-width text-width) 2)
 748                                         (/ (- line-width text-width) 2)))
 749                         ((= word-count 2)
 750                                 (list
 751                                         (- line-width text-width)))
 752                         (else
 753                                 (get-fill-space word-count line-width text-widths))))
 754          (fill-space-normal
 755           (map (lambda (x)
 756                  (if (< x word-space)
 757                      word-space
 758                      x))
 759                fill-space))
 760
 761          (line-stencils (if (= word-count 1)
 762                             (list
 763                              point-stencil
 764                              (car stencils)
 765                              point-stencil)
 766                             stencils)))
 767
 768     (if (= text-direction LEFT)
 769         (set! line-stencils (reverse line-stencils)))
 770
 771     (if (null? (remove ly:stencil-empty? orig-stencils))
 772         empty-stencil
 773         (stack-stencils-padding-list X
 774                                      RIGHT fill-space-normal line-stencils))))
 775
 776 (define-builtin-markup-command (line layout props args)
 777   (markup-list?)
 778   align
 779   ((word-space)
 780    (text-direction RIGHT))
 781   "Put @var{args} in a horizontal line.  The property @code{word-space}
 782 determines the space between each markup in @var{args}.
 783
 784 @lilypond[verbatim,quote]
 785 \\markup {
 786   \\line {
 787     A simple line of text
 788   }
 789 }
 790 @end lilypond"
 791   (let ((stencils (interpret-markup-list layout props args)))
 792     (if (= text-direction LEFT)
 793         (set! stencils (reverse stencils)))
 794     (stack-stencil-line
 795      word-space
 796      (remove ly:stencil-empty? stencils))))
 797
 798 (define-builtin-markup-command (concat layout props args)
 799   (markup-list?)
 800   align
 801   ()
 802   "
 803 @cindex concatenating text
 804 @cindex ligatures in text
 805
 806 Concatenate @var{args} in a horizontal line, without spaces inbetween.
 807 Strings and simple markups are concatenated on the input level, allowing
 808 ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
 809 equivalent to @code{\"fi\"}.
 810
 811 @lilypond[verbatim,quote]
 812 \\markup {
 813   \\bold {
 814     au
 815     \\concat {
 816       Mouv
 817       \\super
 818       t
 819     }
 820   }
 821 }
 822 @end lilypond"
 823   (define (concat-string-args arg-list)
 824     (fold-right (lambda (arg result-list)
 825                   (let ((result (if (pair? result-list)
 826                                     (car result-list)
 827                                   '())))
 828                     (if (and (pair? arg) (eqv? (car arg) simple-markup))
 829                       (set! arg (cadr arg)))
 830                     (if (and (string? result) (string? arg))
 831                         (cons (string-append arg result) (cdr result-list))
 832                       (cons arg result-list))))
 833                 '()
 834                 arg-list))
 835
 836   (interpret-markup layout
 837                     (prepend-alist-chain 'word-space 0 props)
 838                     (make-line-markup (if (markup-command-list? args)
 839                                           args
 840                                           (concat-string-args args)))))
 841
 842 (define (wordwrap-stencils stencils
 843                            justify base-space line-width text-dir)
 844   "Perform simple wordwrap, return stencil of each line."
 845   (define space (if justify
 846                     ;; justify only stretches lines.
 847                     (* 0.7 base-space)
 848                     base-space))
 849   (define (take-list width space stencils
 850                      accumulator accumulated-width)
 851     "Return (head-list . tail) pair, with head-list fitting into width"
 852     (if (null? stencils)
 853         (cons accumulator stencils)
 854         (let* ((first (car stencils))
 855                (first-wid (cdr (ly:stencil-extent (car stencils) X)))
 856                (newwid (+ space first-wid accumulated-width)))
 857           (if (or (null? accumulator)
 858                   (< newwid width))
 859               (take-list width space
 860                          (cdr stencils)
 861                          (cons first accumulator)
 862                          newwid)
 863               (cons accumulator stencils)))))
 864   (let loop ((lines '())
 865              (todo stencils))
 866     (let* ((line-break (take-list line-width space todo
 867                                   '() 0.0))
 868            (line-stencils (car line-break))
 869            (space-left (- line-width
 870                           (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
 871                                         line-stencils))))
 872            (line-word-space (cond ((not justify) space)
 873                                   ;; don't stretch last line of paragraph.
 874                                   ;; hmmm . bug - will overstretch the last line in some case.
 875                                   ((null? (cdr line-break))
 876                                    base-space)
 877                                   ((null? line-stencils) 0.0)
 878                                   ((null? (cdr line-stencils)) 0.0)
 879                                   (else (/ space-left (1- (length line-stencils))))))
 880            (line (stack-stencil-line line-word-space
 881                                      (if (= text-dir RIGHT)
 882                                          (reverse line-stencils)
 883                                          line-stencils))))
 884       (if (pair? (cdr line-break))
 885           (loop (cons line lines)
 886                 (cdr line-break))
 887           (begin
 888             (if (= text-dir LEFT)
 889                 (set! line
 890                       (ly:stencil-translate-axis
 891                        line
 892                        (- line-width (interval-end (ly:stencil-extent line X)))
 893                        X)))
 894             (reverse (cons line lines)))))))
 895
 896 (define-builtin-markup-list-command (wordwrap-internal layout props justify args)
 897   (boolean? markup-list?)
 898   ((line-width #f)
 899    (word-space)
 900    (text-direction RIGHT))
 901   "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
 902   (wordwrap-stencils (remove ly:stencil-empty?
 903                              (interpret-markup-list layout props args))
 904                      justify
 905                      word-space
 906                      (or line-width
 907                          (ly:output-def-lookup layout 'line-width))
 908                      text-direction))
 909
 910 (define-builtin-markup-command (justify layout props args)
 911   (markup-list?)
 912   align
 913   ((baseline-skip)
 914    wordwrap-internal-markup-list)
 915   "
 916 @cindex justifying text
 917
 918 Like wordwrap, but with lines stretched to justify the margins.
 919 Use @code{\\override #'(line-width . @var{X})} to set the line width;
 920 @var{X}@tie{}is the number of staff spaces.
 921
 922 @lilypond[verbatim,quote]
 923 \\markup {
 924   \\justify {
 925     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
 926     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
 927     Ut enim ad minim veniam, quis nostrud exercitation ullamco
 928     laboris nisi ut aliquip ex ea commodo consequat.
 929   }
 930 }
 931 @end lilypond"
 932   (stack-lines DOWN 0.0 baseline-skip
 933                (wordwrap-internal-markup-list layout props #t args)))
 934
 935 (define-builtin-markup-command (wordwrap layout props args)
 936   (markup-list?)
 937   align
 938   ((baseline-skip)
 939    wordwrap-internal-markup-list)
 940   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
 941 the line width, where @var{X} is the number of staff spaces.
 942
 943 @lilypond[verbatim,quote]
 944 \\markup {
 945   \\wordwrap {
 946     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
 947     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
 948     Ut enim ad minim veniam, quis nostrud exercitation ullamco
 949     laboris nisi ut aliquip ex ea commodo consequat.
 950   }
 951 }
 952 @end lilypond"
 953   (stack-lines DOWN 0.0 baseline-skip
 954                (wordwrap-internal-markup-list layout props #f args)))
 955
 956 (define-builtin-markup-list-command (wordwrap-string-internal layout props justify arg)
 957   (boolean? string?)
 958   ((line-width)
 959    (word-space)
 960    (text-direction RIGHT))
 961   "Internal markup list command used to define @code{\\justify-string} and
 962 @code{\\wordwrap-string}."
 963   (let* ((para-strings (regexp-split
 964                         (string-regexp-substitute
 965                          "\r" "\n"
 966                          (string-regexp-substitute "\r\n" "\n" arg))
 967                         "\n[ \t\n]*\n[ \t\n]*"))
 968          (list-para-words (map (lambda (str)
 969                                  (regexp-split str "[ \t\n]+"))
 970                                para-strings))
 971          (para-lines (map (lambda (words)
 972                             (let* ((stencils
 973                                     (remove ly:stencil-empty?
 974                                             (map (lambda (x)
 975                                                    (interpret-markup layout props x))
 976                                                  words))))
 977                               (wordwrap-stencils stencils
 978                                                  justify word-space
 979                                                  line-width text-direction)))
 980                           list-para-words)))
 981     (apply append para-lines)))
 982
 983 (define-builtin-markup-command (wordwrap-string layout props arg)
 984   (string?)
 985   align
 986   ((baseline-skip)
 987    wordwrap-string-internal-markup-list)
 988   "Wordwrap a string.  Paragraphs may be separated with double newlines.
 989
 990 @lilypond[verbatim,quote]
 991 \\markup {
 992   \\override #'(line-width . 40)
 993   \\wordwrap-string #\"Lorem ipsum dolor sit amet, consectetur
 994     adipisicing elit, sed do eiusmod tempor incididunt ut labore
 995     et dolore magna aliqua.
 996
 997
 998     Ut enim ad minim veniam, quis nostrud exercitation ullamco
 999     laboris nisi ut aliquip ex ea commodo consequat.
1000
1001
1002     Excepteur sint occaecat cupidatat non proident, sunt in culpa
1003     qui officia deserunt mollit anim id est laborum\"
1004 }
1005 @end lilypond"
1006   (stack-lines DOWN 0.0 baseline-skip
1007                (wordwrap-string-internal-markup-list layout props #f arg)))
1008
1009 (define-builtin-markup-command (justify-string layout props arg)
1010   (string?)
1011   align
1012   ((baseline-skip)
1013    wordwrap-string-internal-markup-list)
1014   "Justify a string.  Paragraphs may be separated with double newlines
1015
1016 @lilypond[verbatim,quote]
1017 \\markup {
1018   \\override #'(line-width . 40)
1019   \\justify-string #\"Lorem ipsum dolor sit amet, consectetur
1020     adipisicing elit, sed do eiusmod tempor incididunt ut labore
1021     et dolore magna aliqua.
1022
1023
1024     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1025     laboris nisi ut aliquip ex ea commodo consequat.
1026
1027
1028     Excepteur sint occaecat cupidatat non proident, sunt in culpa
1029     qui officia deserunt mollit anim id est laborum\"
1030 }
1031 @end lilypond"
1032   (stack-lines DOWN 0.0 baseline-skip
1033                (wordwrap-string-internal-markup-list layout props #t arg)))
1034
1035 (define-builtin-markup-command (wordwrap-field layout props symbol)
1036   (symbol?)
1037   align
1038   ()
1039   "Wordwrap the data which has been assigned to @var{symbol}."
1040   (let* ((m (chain-assoc-get symbol props)))
1041     (if (string? m)
1042         (wordwrap-string-markup layout props m)
1043         empty-stencil)))
1044
1045 (define-builtin-markup-command (justify-field layout props symbol)
1046   (symbol?)
1047   align
1048   ()
1049   "Justify the data which has been assigned to @var{symbol}."
1050   (let* ((m (chain-assoc-get symbol props)))
1051     (if (string? m)
1052         (justify-string-markup layout props m)
1053         empty-stencil)))
1054
1055 (define-builtin-markup-command (combine layout props m1 m2)
1056   (markup? markup?)
1057   align
1058   ()
1059   "
1060 @cindex merging text
1061
1062 Print two markups on top of each other.
1063 @lilypond[verbatim,quote]
1064 \\markup {
1065   \\fontsize #5
1066   \\override #'(thickness . 2)
1067   \\combine
1068   \\draw-line #'(0 . 4)
1069   \\arrow-head #Y #DOWN ##f
1070 }
1071 @end lilypond"
1072   (let* ((s1 (interpret-markup layout props m1))
1073          (s2 (interpret-markup layout props m2)))
1074     (ly:stencil-add s1 s2)))
1075
1076 ;;
1077 ;; TODO: should extract baseline-skip from each argument somehow..
1078 ;;
1079 (define-builtin-markup-command (column layout props args)
1080   (markup-list?)
1081   align
1082   ((baseline-skip))
1083   "
1084 @cindex stacking text in a column
1085
1086 Stack the markups in @var{args} vertically.  The property
1087 @code{baseline-skip} determines the space between each
1088 markup in @var{args}.
1089
1090 @lilypond[verbatim,quote]
1091 \\markup {
1092   \\column {
1093     one
1094     two
1095     three
1096   }
1097 }
1098 @end lilypond"
1099   (let ((arg-stencils (interpret-markup-list layout props args)))
1100     (stack-lines -1 0.0 baseline-skip
1101                  (remove ly:stencil-empty? arg-stencils))))
1102
1103 (define-builtin-markup-command (dir-column layout props args)
1104   (markup-list?)
1105   align
1106   ((direction)
1107    (baseline-skip))
1108   "
1109 @cindex changing direction of text columns
1110
1111 Make a column of args, going up or down, depending on the setting
1112 of the @code{#'direction} layout property.
1113
1114 @lilypond[verbatim,quote]
1115 \\markup {
1116   \\override #'(direction . 1) {
1117     \\dir-column {
1118       going up
1119     }
1120   }
1121   \\dir-column {
1122     going down
1123   }
1124 }
1125 @end lilypond"
1126   (stack-lines (if (number? direction) direction -1)
1127                0.0
1128                baseline-skip
1129                (interpret-markup-list layout props args)))
1130
1131 (define-builtin-markup-command (center-align layout props args)
1132   (markup-list?)
1133   align
1134   ((baseline-skip))
1135   "
1136 @cindex centering a column of text
1137
1138 Put @code{args} in a centered column.
1139
1140 @lilypond[verbatim,quote]
1141 \\markup {
1142   \\center-align {
1143     one
1144     two
1145     three
1146   }
1147 }
1148 @end lilypond"
1149   (let* ((mols (interpret-markup-list layout props args))
1150          (cmols (map (lambda (x) (ly:stencil-aligned-to x X CENTER)) mols)))
1151     (stack-lines -1 0.0 baseline-skip cmols)))
1152
1153 (define-builtin-markup-command (vcenter layout props arg)
1154   (markup?)
1155   align
1156   ()
1157   "
1158 @cindex vertically centering text
1159
1160 Align @code{arg} to its Y@tie{}center.
1161
1162 @lilypond[verbatim,quote]
1163 \\markup {
1164   \\arrow-head #X #RIGHT ##f
1165   \\vcenter
1166   Centered
1167   \\arrow-head #X #LEFT ##f
1168 }
1169 @end lilypond"
1170   (let* ((mol (interpret-markup layout props arg)))
1171     (ly:stencil-aligned-to mol Y CENTER)))
1172
1173 (define-builtin-markup-command (hcenter layout props arg)
1174   (markup?)
1175   align
1176   ()
1177   "
1178 @cindex horizontally centering text
1179
1180 Align @code{arg} to its X@tie{}center.
1181
1182 @lilypond[verbatim,quote]
1183 \\markup {
1184   \\column {
1185     ↓
1186     \\hcenter
1187     centered
1188   }
1189 }
1190 @end lilypond"
1191   (let* ((mol (interpret-markup layout props arg)))
1192     (ly:stencil-aligned-to mol X CENTER)))
1193
1194 (define-builtin-markup-command (right-align layout props arg)
1195   (markup?)
1196   align
1197   ()
1198   "
1199 @cindex right aligning text
1200
1201 Align @var{arg} on its right edge.
1202
1203 @lilypond[verbatim,quote]
1204 \\markup {
1205   \\column {
1206     ↓
1207     \\right-align
1208     right-aligned
1209   }
1210 }
1211 @end lilypond"
1212   (let* ((m (interpret-markup layout props arg)))
1213     (ly:stencil-aligned-to m X RIGHT)))
1214
1215 (define-builtin-markup-command (left-align layout props arg)
1216   (markup?)
1217   align
1218   ()
1219   "
1220 @cindex left aligning text
1221
1222 Align @var{arg} on its left edge.
1223
1224 @lilypond[verbatim,quote]
1225 \\markup {
1226   \\column {
1227     ↓
1228     \\left-align
1229     left-aligned
1230   }
1231 }
1232 @end lilypond"
1233   (let* ((m (interpret-markup layout props arg)))
1234     (ly:stencil-aligned-to m X LEFT)))
1235
1236 (define-builtin-markup-command (general-align layout props axis dir arg)
1237   (integer? number? markup?)
1238   align
1239   ()
1240   "
1241 @cindex controlling general text alignment
1242
1243 Align @var{arg} in @var{axis} direction to the @var{dir} side.
1244
1245 @lilypond[verbatim,quote]
1246 \\markup {
1247   \\column {
1248     ↓
1249     \\general-align #X #LEFT
1250     \\line { X, Left }
1251     ↓
1252     \\general-align #X #CENTER
1253     \\line { X, Center }
1254     \\null
1255     \\line {
1256       \\arrow-head #X #RIGHT ##f
1257       \\general-align #Y #DOWN
1258       \\line { Y, Down }
1259       \\arrow-head #X #LEFT ##f
1260     }
1261     \\line {
1262       \\arrow-head #X #RIGHT ##f
1263       \\general-align #Y #3.2
1264       \\line {
1265         \\line { Y, Arbitrary alignment }
1266       }
1267       \\arrow-head #X #LEFT ##f
1268     }
1269   }
1270 }
1271 @end lilypond"
1272   (let* ((m (interpret-markup layout props arg)))
1273     (ly:stencil-aligned-to m axis dir)))
1274
1275 (define-builtin-markup-command (halign layout props dir arg)
1276   (number? markup?)
1277   align
1278   ()
1279   "
1280 @cindex setting horizontal text alignment
1281
1282 Set horizontal alignment.  If @var{dir} is @code{-1}, then it is
1283 left-aligned, while @code{+1} is right.  Values in between interpolate
1284 alignment accordingly.
1285
1286 @lilypond[verbatim,quote]
1287 \\markup {
1288   \\column {
1289     ↓
1290     \\halign #LEFT
1291     Left
1292     ↓
1293     \\halign #CENTER
1294     Center
1295     ↓
1296     \\halign #RIGHT
1297     Right
1298     ↓
1299     \\halign #1.2
1300     \\line {
1301       Arbitrary alignment
1302     }
1303   }
1304 }
1305 @end lilypond"
1306   (let* ((m (interpret-markup layout props arg)))
1307     (ly:stencil-aligned-to m X dir)))
1308
1309 (define-builtin-markup-command (with-dimensions layout props x y arg)
1310   (number-pair? number-pair? markup?)
1311   other
1312   ()
1313   "
1314 @cindex setting extent of text objects
1315
1316 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
1317   (let* ((m (interpret-markup layout props arg)))
1318     (ly:make-stencil (ly:stencil-expr m) x y)))
1319
1320 (define-builtin-markup-command (pad-around layout props amount arg)
1321   (number? markup?)
1322   align
1323   ()
1324   "Add padding @var{amount} all around @var{arg}."
1325   (let* ((m (interpret-markup layout props arg))
1326          (x (ly:stencil-extent m X))
1327          (y (ly:stencil-extent m Y)))
1328     (ly:make-stencil (ly:stencil-expr m)
1329                      (interval-widen x amount)
1330                      (interval-widen y amount))))
1331
1332 (define-builtin-markup-command (pad-x layout props amount arg)
1333   (number? markup?)
1334   align
1335   ()
1336   "
1337 @cindex padding text horizontally
1338
1339 Add padding @var{amount} around @var{arg} in the X@tie{}direction."
1340   (let* ((m (interpret-markup layout props arg))
1341          (x (ly:stencil-extent m X))
1342          (y (ly:stencil-extent m Y)))
1343     (ly:make-stencil (ly:stencil-expr m)
1344                      (interval-widen x amount)
1345                      y)))
1346
1347 (define-builtin-markup-command (put-adjacent layout props arg1 axis dir arg2)
1348   (markup? integer? ly:dir? markup?)
1349   align
1350   ()
1351   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1352   (let ((m1 (interpret-markup layout props arg1))
1353         (m2 (interpret-markup layout props arg2)))
1354     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1355
1356 (define-builtin-markup-command (transparent layout props arg)
1357   (markup?)
1358   other
1359   ()
1360   "Make the argument transparent.
1361
1362 @lilypond[verbatim,quote]
1363 \\markup {
1364   \\transparent {
1365     invisible text
1366   }
1367 }
1368 @end lilypond"
1369   (let* ((m (interpret-markup layout props arg))
1370          (x (ly:stencil-extent m X))
1371          (y (ly:stencil-extent m Y)))
1372     (ly:make-stencil "" x y)))
1373
1374 (define-builtin-markup-command (pad-to-box layout props x-ext y-ext arg)
1375   (number-pair? number-pair? markup?)
1376   align
1377   ()
1378   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space."
1379   (let* ((m (interpret-markup layout props arg))
1380          (x (ly:stencil-extent m X))
1381          (y (ly:stencil-extent m Y)))
1382     (ly:make-stencil (ly:stencil-expr m)
1383                      (interval-union x-ext x)
1384                      (interval-union y-ext y))))
1385
1386 (define-builtin-markup-command (hcenter-in layout props length arg)
1387   (number? markup?)
1388   align
1389   ()
1390   "Center @var{arg} horizontally within a box of extending
1391 @var{length}/2 to the left and right."
1392   (interpret-markup layout props
1393                     (make-pad-to-box-markup
1394                      (cons (/ length -2) (/ length 2))
1395                      '(0 . 0)
1396                      (make-hcenter-markup arg))))
1397
1398 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1399 ;; property
1400 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1401
1402 (define-builtin-markup-command (fromproperty layout props symbol)
1403   (symbol?)
1404   other
1405   ()
1406   "Read the @var{symbol} from property settings, and produce a stencil
1407 from the markup contained within.  If @var{symbol} is not defined, it
1408 returns an empty markup.
1409
1410 @lilypond[verbatim,quote]
1411 \\header {
1412   myTitle = \"myTitle\"
1413   title = \\markup {
1414     from
1415     \\italic
1416     \\fromproperty #'header:myTitle
1417   }
1418 }
1419 \\markup {
1420   \\null
1421 }
1422 @end lilypond"
1423   (let ((m (chain-assoc-get symbol props)))
1424     (if (markup? m)
1425         (interpret-markup layout props m)
1426         empty-stencil)))
1427
1428 (define-builtin-markup-command (on-the-fly layout props procedure arg)
1429   (symbol? markup?)
1430   other
1431   ()
1432   "Apply the @var{procedure} markup command to @var{arg}.
1433 @var{procedure} should take a single argument."
1434   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
1435     (set-object-property! anonymous-with-signature
1436                           'markup-signature
1437                           (list markup?))
1438     (interpret-markup layout props (list anonymous-with-signature arg))))
1439
1440 (define-builtin-markup-command (override layout props new-prop arg)
1441   (pair? markup?)
1442   other
1443   ()
1444   "
1445 @cindex overriding properties within text markup
1446
1447 Add the first argument in to the property list.  Properties may be
1448 any sort of property supported by @rinternals{font-interface} and
1449 @rinternals{text-interface}, for example
1450
1451 @example
1452 \\override #'(font-family . married) \"bla\"
1453 @end example
1454
1455 @lilypond[verbatim,quote]
1456 \\markup {
1457   \\line {
1458     \\column {
1459       default
1460       baseline-skip
1461     }
1462     \\hspace #2
1463     \\override #'(baseline-skip . 4) {
1464       \\column {
1465         increased
1466         baseline-skip
1467       }
1468     }
1469   }
1470 }
1471 @end lilypond"
1472   (interpret-markup layout (cons (list new-prop) props) arg))
1473
1474 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1475 ;; files
1476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1477
1478 (define-builtin-markup-command (verbatim-file layout props name)
1479   (string?)
1480   other
1481   ()
1482   "Read the contents of a file, and include it verbatim.
1483
1484 @lilypond[verbatim,quote]
1485 \\markup {
1486   \\verbatim-file #\"simple.ly\"
1487 }
1488 @end lilypond"
1489   (interpret-markup layout props
1490                     (if  (ly:get-option 'safe)
1491                          "verbatim-file disabled in safe mode"
1492                          (let* ((str (ly:gulp-file name))
1493                                 (lines (string-split str #\nl)))
1494                            (make-typewriter-markup
1495                             (make-column-markup lines))))))
1496
1497 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1498 ;; fonts.
1499 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1500
1501 (define-builtin-markup-command (bigger layout props arg)
1502   (markup?)
1503   font
1504   ()
1505   "Increase the font size relative to current setting.
1506
1507 @lilypond[verbatim,quote]
1508 \\markup {
1509   \\huge {
1510     huge
1511     \\hspace #2
1512     \\bigger {
1513       bigger
1514     }
1515     \\hspace #2
1516     huge
1517   }
1518 }
1519 @end lilypond"
1520   (interpret-markup layout props
1521    `(,fontsize-markup 1 ,arg)))
1522
1523 (define-builtin-markup-command (smaller layout props arg)
1524   (markup?)
1525   font
1526   ()
1527   "Decrease the font size relative to current setting.
1528
1529 @lilypond[verbatim,quote]
1530 \\markup {
1531   \\fontsize #3.5 {
1532     some large text
1533     \\hspace #2
1534     \\smaller {
1535       a bit smaller
1536     }
1537     \\hspace #2
1538     more large text
1539   }
1540 }
1541 @end lilypond"
1542   (interpret-markup layout props
1543    `(,fontsize-markup -1 ,arg)))
1544
1545 (define-builtin-markup-command (larger layout props arg)
1546   (markup?)
1547   font
1548   ()
1549   "Copy of the @code{\\bigger} command.
1550
1551 @lilypond[verbatim,quote]
1552 \\markup {
1553   default
1554   \\hspace #2
1555   \\larger
1556   larger
1557 }
1558 @end lilypond"
1559   (interpret-markup layout props (make-bigger-markup arg)))
1560
1561 (define-builtin-markup-command (finger layout props arg)
1562   (markup?)
1563   font
1564   ()
1565   "Set the argument as small numbers.
1566 @lilypond[verbatim,quote]
1567 \\markup {
1568   \\finger {
1569     1 2 3 4 5
1570   }
1571 }
1572 @end lilypond"
1573   (interpret-markup layout
1574                     (cons '((font-size . -5) (font-encoding . fetaNumber)) props)
1575                     arg))
1576
1577 (define-builtin-markup-command (abs-fontsize layout props size arg)
1578   (number? markup?)
1579   font
1580   ()
1581   "Use @var{size} as the absolute font size to display @var{arg}.
1582 Adjust baseline skip and word space accordingly.
1583 @lilypond[verbatim,quote]
1584 \\markup {
1585   default text font size
1586   \\hspace #2
1587   \\abs-fontsize #16 { text font size 16 }
1588   \\hspace #2
1589   \\abs-fontsize #12 { text font size 12 }
1590 }
1591 @end lilypond"
1592   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
1593          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
1594          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
1595          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
1596          (magnification (/ size ref-size)))
1597     (interpret-markup layout
1598                       (cons `((baseline-skip . ,(* magnification ref-baseline))
1599                               (word-space . ,(* magnification ref-word-space))
1600                               (font-size . ,(magnification->font-size magnification)))
1601                             props)
1602                       arg)))
1603
1604 (define-builtin-markup-command (fontsize layout props increment arg)
1605   (number? markup?)
1606   font
1607   ((font-size 0)
1608    (word-space 1)
1609    (baseline-skip 2))
1610   "Add @var{increment} to the font-size.  Adjust baseline skip accordingly.
1611 @lilypond[verbatim,quote]
1612 \\markup {
1613   default
1614   \\hspace #2
1615   \\fontsize #-1.5
1616   smaller
1617 }
1618 @end lilypond"
1619   (let ((entries (list
1620                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
1621                   (cons 'word-space (* word-space (magstep increment)))
1622                   (cons 'font-size (+ font-size increment)))))
1623     (interpret-markup layout (cons entries props) arg)))
1624
1625 (define-builtin-markup-command (magnify layout props sz arg)
1626   (number? markup?)
1627   font
1628   ()
1629   "
1630 @cindex magnifying text
1631
1632 Set the font magnification for its argument.  In the following
1633 example, the middle@tie{}A is 10% larger:
1634
1635 @example
1636 A \\magnify #1.1 @{ A @} A
1637 @end example
1638
1639 Note: Magnification only works if a font name is explicitly selected.
1640 Use @code{\\fontsize} otherwise.
1641
1642 @lilypond[verbatim,quote]
1643 \\markup {
1644   default
1645   \\hspace #2
1646   \\magnify #1.5 {
1647     50% larger
1648   }
1649 }
1650 @end lilypond"
1651   (interpret-markup
1652    layout
1653    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
1654    arg))
1655
1656 (define-builtin-markup-command (bold layout props arg)
1657   (markup?)
1658   font
1659   ()
1660   "Switch to bold font-series.
1661
1662 @lilypond[verbatim,quote]
1663 \\markup {
1664   default
1665   \\hspace #2
1666   \\bold
1667   bold
1668 }
1669 @end lilypond"
1670   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
1671
1672 (define-builtin-markup-command (sans layout props arg)
1673   (markup?)
1674   font
1675   ()
1676   "Switch to the sans serif family.
1677
1678 @lilypond[verbatim,quote]
1679 \\markup {
1680   default
1681   \\hspace #2
1682   \\sans {
1683     sans serif
1684   }
1685 }
1686 @end lilypond"
1687   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
1688
1689 (define-builtin-markup-command (number layout props arg)
1690   (markup?)
1691   font
1692   ()
1693   "Set font family to @code{number}, which yields the font used for
1694 time signatures and fingerings.  This font only contains numbers and
1695 some punctuation.  It doesn't have any letters.
1696
1697 @lilypond[verbatim,quote]
1698 \\markup {
1699   \\number {
1700     0 1 2 3 4 5 6 7 8 9 . ,
1701   }
1702 }
1703 @end lilypond"
1704   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg))
1705
1706 (define-builtin-markup-command (roman layout props arg)
1707   (markup?)
1708   font
1709   ()
1710   "Set font family to @code{roman}.
1711
1712 @lilypond[verbatim,quote]
1713 \\markup {
1714   \\sans \\bold {
1715     sans serif, bold
1716     \\hspace #2
1717     \\roman {
1718       text in roman font family
1719     }
1720     \\hspace #2
1721     return to sans
1722   }
1723 }
1724 @end lilypond"
1725   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
1726
1727 (define-builtin-markup-command (huge layout props arg)
1728   (markup?)
1729   font
1730   ()
1731   "Set font size to +2.
1732
1733 @lilypond[verbatim,quote]
1734 \\markup {
1735   default
1736   \\hspace #2
1737   \\huge
1738   huge
1739 }
1740 @end lilypond"
1741   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
1742
1743 (define-builtin-markup-command (large layout props arg)
1744   (markup?)
1745   font
1746   ()
1747   "Set font size to +1.
1748
1749 @lilypond[verbatim,quote]
1750 \\markup {
1751   default
1752   \\hspace #2
1753   \\large
1754   large
1755 }
1756 @end lilypond"
1757   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
1758
1759 (define-builtin-markup-command (normalsize layout props arg)
1760   (markup?)
1761   font
1762   ()
1763   "Set font size to default.
1764
1765 @lilypond[verbatim,quote]
1766 \\markup {
1767   \\teeny {
1768     this is very small
1769     \\hspace #2
1770     \\normalsize {
1771       normal size
1772     }
1773     \\hspace #2
1774     teeny again
1775   }
1776 }
1777 @end lilypond"
1778   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
1779
1780 (define-builtin-markup-command (small layout props arg)
1781   (markup?)
1782   font
1783   ()
1784   "Set font size to -1.
1785
1786 @lilypond[verbatim,quote]
1787 \\markup {
1788   default
1789   \\hspace #2
1790   \\small
1791   small
1792 }
1793 @end lilypond"
1794   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
1795
1796 (define-builtin-markup-command (tiny layout props arg)
1797   (markup?)
1798   font
1799   ()
1800   "Set font size to -2.
1801
1802 @lilypond[verbatim,quote]
1803 \\markup {
1804   default
1805   \\hspace #2
1806   \\tiny
1807   tiny
1808 }
1809 @end lilypond"
1810   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
1811
1812 (define-builtin-markup-command (teeny layout props arg)
1813   (markup?)
1814   font
1815   ()
1816   "Set font size to -3.
1817
1818 @lilypond[verbatim,quote]
1819 \\markup {
1820   default
1821   \\hspace #2
1822   \\teeny
1823   teeny
1824 }
1825 @end lilypond"
1826   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
1827
1828 (define-builtin-markup-command (fontCaps layout props arg)
1829   (markup?)
1830   font
1831   ()
1832   "Set @code{font-shape} to @code{caps}"
1833   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
1834
1835 ;; Poor man's caps
1836 (define-builtin-markup-command (smallCaps layout props text)
1837   (markup?)
1838   font
1839   ()
1840   "Emit @var{arg} as small caps.
1841
1842 Note: @code{\\smallCaps} does not support accented characters.
1843
1844 @lilypond[verbatim,quote]
1845 \\markup {
1846   default
1847   \\hspace #2
1848   \\smallCaps {
1849     Text in small caps
1850   }
1851 }
1852 @end lilypond"
1853   (define (char-list->markup chars lower)
1854     (let ((final-string (string-upcase (reverse-list->string chars))))
1855       (if lower
1856           (markup #:fontsize -2 final-string)
1857           final-string)))
1858   (define (make-small-caps rest-chars currents current-is-lower prev-result)
1859     (if (null? rest-chars)
1860         (make-concat-markup
1861           (reverse! (cons (char-list->markup currents current-is-lower)
1862                           prev-result)))
1863         (let* ((ch (car rest-chars))
1864                (is-lower (char-lower-case? ch)))
1865           (if (or (and current-is-lower is-lower)
1866                   (and (not current-is-lower) (not is-lower)))
1867               (make-small-caps (cdr rest-chars)
1868                                (cons ch currents)
1869                                is-lower
1870                                prev-result)
1871               (make-small-caps (cdr rest-chars)
1872                                (list ch)
1873                                is-lower
1874                                (if (null? currents)
1875                                    prev-result
1876                                    (cons (char-list->markup
1877                                             currents current-is-lower)
1878                                          prev-result)))))))
1879   (interpret-markup layout props
1880     (if (string? text)
1881         (make-small-caps (string->list text) (list) #f (list))
1882         text)))
1883
1884 (define-builtin-markup-command (caps layout props arg)
1885   (markup?)
1886   font
1887   ()
1888   "Copy of the @code{\\smallCaps} command.
1889
1890 @lilypond[verbatim,quote]
1891 \\markup {
1892   default
1893   \\hspace #2
1894   \\caps {
1895     Text in small caps
1896   }
1897 }
1898 @end lilypond"
1899   (interpret-markup layout props (make-smallCaps-markup arg)))
1900
1901 (define-builtin-markup-command (dynamic layout props arg)
1902   (markup?)
1903   font
1904   ()
1905   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
1906 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
1907 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
1908 done in a different font.  The recommended font for this is bold and italic.
1909 @lilypond[verbatim,quote]
1910 \\markup {
1911   \\dynamic {
1912     sfzp
1913   }
1914 }
1915 @end lilypond"
1916   (interpret-markup
1917    layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg))
1918
1919 (define-builtin-markup-command (text layout props arg)
1920   (markup?)
1921   font
1922   ()
1923   "Use a text font instead of music symbol or music alphabet font.
1924
1925 @lilypond[verbatim,quote]
1926 \\markup {
1927   \\number {
1928     1, 2,
1929     \\text {
1930       three, four,
1931     }
1932     5
1933   }
1934 }
1935 @end lilypond"
1936
1937   ;; ugh - latin1
1938   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
1939                     arg))
1940
1941 (define-builtin-markup-command (italic layout props arg)
1942   (markup?)
1943   font
1944   ()
1945   "Use italic @code{font-shape} for @var{arg}.
1946
1947 @lilypond[verbatim,quote]
1948 \\markup {
1949   default
1950   \\hspace #2
1951   \\italic
1952   italic
1953 }
1954 @end lilypond"
1955   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
1956
1957 (define-builtin-markup-command (typewriter layout props arg)
1958   (markup?)
1959   font
1960   ()
1961   "Use @code{font-family} typewriter for @var{arg}.
1962
1963 @lilypond[verbatim,quote]
1964 \\markup {
1965   default
1966   \\hspace #2
1967   \\typewriter
1968   typewriter
1969 }
1970 @end lilypond"
1971   (interpret-markup
1972    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
1973
1974 (define-builtin-markup-command (upright layout props arg)
1975   (markup?)
1976   font
1977   ()
1978   "Set font shape to @code{upright}.  This is the opposite of @code{italic}.
1979
1980 @lilypond[verbatim,quote]
1981 \\markup {
1982   \\italic {
1983     italic text
1984     \\hspace #2
1985     \\upright {
1986       upright text
1987     }
1988     \\hspace #2
1989     italic again
1990   }
1991 }
1992 @end lilypond"
1993   (interpret-markup
1994    layout (prepend-alist-chain 'font-shape 'upright props) arg))
1995
1996 (define-builtin-markup-command (medium layout props arg)
1997   (markup?)
1998   font
1999   ()
2000   "Switch to medium font series (in contrast to bold).
2001
2002 @lilypond[verbatim,quote]
2003 \\markup {
2004   \\bold {
2005     some bold text
2006     \\hspace #2
2007     \\medium {
2008       medium font series
2009     }
2010     \\hspace #2
2011     bold again
2012   }
2013 }
2014 @end lilypond"
2015   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2016                     arg))
2017
2018 (define-builtin-markup-command (normal-text layout props arg)
2019   (markup?)
2020   font
2021   ()
2022   "Set all font related properties (except the size) to get the default
2023 normal text font, no matter what font was used earlier.
2024
2025 @lilypond[verbatim,quote]
2026 \\markup {
2027   \\huge \\bold \\sans \\caps {
2028     Some text with font overrides
2029     \\hspace #2
2030     \\normal-text {
2031       Default text, same font-size
2032     }
2033     \\hspace #2
2034     More text as before
2035   }
2036 }
2037 @end lilypond"
2038   ;; ugh - latin1
2039   (interpret-markup layout
2040                     (cons '((font-family . roman) (font-shape . upright)
2041                             (font-series . medium) (font-encoding . latin1))
2042                           props)
2043                     arg))
2044
2045 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2046 ;; symbols.
2047 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2048
2049 (define-builtin-markup-command (doublesharp layout props)
2050   ()
2051   music
2052   ()
2053   "Draw a double sharp symbol.
2054
2055 @lilypond[verbatim,quote]
2056 \\markup {
2057   \\doublesharp
2058 }
2059 @end lilypond"
2060   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2061
2062 (define-builtin-markup-command (sesquisharp layout props)
2063   ()
2064   music
2065   ()
2066   "Draw a 3/2 sharp symbol.
2067
2068 @lilypond[verbatim,quote]
2069 \\markup {
2070   \\sesquisharp
2071 }
2072 @end lilypond"
2073   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
2074
2075 (define-builtin-markup-command (sharp layout props)
2076   ()
2077   music
2078   ()
2079   "Draw a sharp symbol.
2080
2081 @lilypond[verbatim,quote]
2082 \\markup {
2083   \\sharp
2084 }
2085 @end lilypond"
2086   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2087
2088 (define-builtin-markup-command (semisharp layout props)
2089   ()
2090   music
2091   ()
2092   "Draw a semi sharp symbol.
2093
2094 @lilypond[verbatim,quote]
2095 \\markup {
2096   \\semisharp
2097 }
2098 @end lilypond"
2099   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2100
2101 (define-builtin-markup-command (natural layout props)
2102   ()
2103   music
2104   ()
2105   "Draw a natural symbol.
2106
2107 @lilypond[verbatim,quote]
2108 \\markup {
2109   \\natural
2110 }
2111 @end lilypond"
2112   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2113
2114 (define-builtin-markup-command (semiflat layout props)
2115   ()
2116   music
2117   ()
2118   "Draw a semiflat symbol.
2119
2120 @lilypond[verbatim,quote]
2121 \\markup {
2122   \\semiflat
2123 }
2124 @end lilypond"
2125   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2126
2127 (define-builtin-markup-command (flat layout props)
2128   ()
2129   music
2130   ()
2131   "Draw a flat symbol.
2132
2133 @lilypond[verbatim,quote]
2134 \\markup {
2135   \\flat
2136 }
2137 @end lilypond"
2138   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2139
2140 (define-builtin-markup-command (sesquiflat layout props)
2141   ()
2142   music
2143   ()
2144   "Draw a 3/2 flat symbol.
2145
2146 @lilypond[verbatim,quote]
2147 \\markup {
2148   \\sesquiflat
2149 }
2150 @end lilypond"
2151   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2152
2153 (define-builtin-markup-command (doubleflat layout props)
2154   ()
2155   music
2156   ()
2157   "Draw a double flat symbol.
2158
2159 @lilypond[verbatim,quote]
2160 \\markup {
2161   \\doubleflat
2162 }
2163 @end lilypond"
2164   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2165
2166 (define-builtin-markup-command (with-color layout props color arg)
2167   (color? markup?)
2168   other
2169   ()
2170   "
2171 @cindex coloring text
2172
2173 Draw @var{arg} in color specified by @var{color}.
2174
2175 @lilypond[verbatim,quote]
2176 \\markup {
2177   \\with-color #red
2178   red
2179   \\hspace #2
2180   \\with-color #green
2181   green
2182   \\hspace #2
2183   \\with-color #blue
2184   blue
2185 }
2186 @end lilypond"
2187   (let ((stil (interpret-markup layout props arg)))
2188     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2189                      (ly:stencil-extent stil X)
2190                      (ly:stencil-extent stil Y))))
2191 \f
2192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2193 ;; glyphs
2194 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2195
2196 (define-builtin-markup-command (arrow-head layout props axis direction filled)
2197   (integer? ly:dir? boolean?)
2198   graphic
2199   ()
2200   "Produce an arrow head in specified direction and axis.
2201 Use the filled head if @var{filled} is specified.
2202 @lilypond[verbatim,quote]
2203 \\markup {
2204   \\fontsize #5 {
2205     \\general-align #Y #DOWN {
2206       \\arrow-head #Y #UP ##t
2207       \\arrow-head #Y #DOWN ##f
2208       \\hspace #2
2209       \\arrow-head #X #RIGHT ##f
2210       \\arrow-head #X #LEFT ##f
2211     }
2212   }
2213 }
2214 @end lilypond"
2215   (let*
2216       ((name (format "arrowheads.~a.~a~a"
2217                      (if filled
2218                          "close"
2219                          "open")
2220                      axis
2221                      direction)))
2222     (ly:font-get-glyph
2223      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2224                                      props))
2225      name)))
2226
2227 (define-builtin-markup-command (musicglyph layout props glyph-name)
2228   (string?)
2229   music
2230   ()
2231   "@var{glyph-name} is converted to a musical symbol; for example,
2232 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2233 the music font.  See @ruser{The Feta font} for a complete listing of
2234 the possible glyphs.
2235
2236 @lilypond[verbatim,quote]
2237 \\markup {
2238   \\musicglyph #\"f\"
2239   \\musicglyph #\"rests.2\"
2240   \\musicglyph #\"clefs.G_change\"
2241 }
2242 @end lilypond"
2243   (let* ((font (ly:paper-get-font layout
2244                                   (cons '((font-encoding . fetaMusic)
2245                                           (font-name . #f))
2246
2247                                                  props)))
2248          (glyph (ly:font-get-glyph font glyph-name)))
2249     (if (null? (ly:stencil-expr glyph))
2250         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2251
2252     glyph))
2253
2254
2255 (define-builtin-markup-command (lookup layout props glyph-name)
2256   (string?)
2257   other
2258   ()
2259   "Lookup a glyph by name.
2260
2261 @lilypond[verbatim,quote]
2262 \\markup {
2263   \\override #'(font-encoding . fetaBraces) {
2264     \\lookup #\"brace200\"
2265     \\hspace #2
2266     \\rotate #180
2267     \\lookup #\"brace180\"
2268   }
2269 }
2270 @end lilypond"
2271   (ly:font-get-glyph (ly:paper-get-font layout props)
2272                      glyph-name))
2273
2274 (define-builtin-markup-command (char layout props num)
2275   (integer?)
2276   other
2277   ()
2278   "Produce a single character.  For example, @code{\\char #65} produces the
2279 letter @q{A}.
2280
2281 @lilypond[verbatim,quote]
2282 \\markup {
2283   \\char #65
2284 }
2285 @end lilypond"
2286   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2287
2288 (define number->mark-letter-vector (make-vector 25 #\A))
2289
2290 (do ((i 0 (1+ i))
2291      (j 0 (1+ j)))
2292     ((>= i 26))
2293   (if (= i (- (char->integer #\I) (char->integer #\A)))
2294       (set! i (1+ i)))
2295   (vector-set! number->mark-letter-vector j
2296                (integer->char (+ i (char->integer #\A)))))
2297
2298 (define number->mark-alphabet-vector (list->vector
2299   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2300
2301 (define (number->markletter-string vec n)
2302   "Double letters for big marks."
2303   (let* ((lst (vector-length vec)))
2304
2305     (if (>= n lst)
2306         (string-append (number->markletter-string vec (1- (quotient n lst)))
2307                        (number->markletter-string vec (remainder n lst)))
2308         (make-string 1 (vector-ref vec n)))))
2309
2310 (define-builtin-markup-command (markletter layout props num)
2311   (integer?)
2312   other
2313   ()
2314   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2315 (skipping letter@tie{}I), and continue with double letters.
2316
2317 @lilypond[verbatim,quote]
2318 \\markup {
2319   \\markletter #8
2320   \\hspace #2
2321   \\markletter #26
2322 }
2323 @end lilypond"
2324   (ly:text-interface::interpret-markup layout props
2325     (number->markletter-string number->mark-letter-vector num)))
2326
2327 (define-builtin-markup-command (markalphabet layout props num)
2328   (integer?)
2329   other
2330   ()
2331    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2332 and continue with double letters.
2333
2334 @lilypond[verbatim,quote]
2335 \\markup {
2336   \\markalphabet #8
2337   \\hspace #2
2338   \\markalphabet #26
2339 }
2340 @end lilypond"
2341    (ly:text-interface::interpret-markup layout props
2342      (number->markletter-string number->mark-alphabet-vector num)))
2343
2344 (define-public (horizontal-slash-interval num forward number-interval mag)
2345   (ly:message "Mag step: ~a" mag)
2346   (if forward
2347     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
2348           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2349           (else (interval-widen number-interval (* mag 0.25))))
2350     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
2351           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2352           (else (interval-widen number-interval (* mag 0.25))))
2353   ))
2354
2355 (define-public (adjust-slash-stencil num forward stencil mag)
2356   (if forward
2357     (cond ((= num 2)
2358               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2359           ((= num 3)
2360               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2361           ;((= num 5)
2362               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
2363           ;((= num 7)
2364           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2365           (else stencil))
2366     (cond ((= num 6)
2367               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
2368           ;((= num 8)
2369           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2370           (else stencil))
2371   )
2372 )
2373
2374 (define (slashed-digit-internal layout props num forward font-size thickness)
2375   (let* ((mag (magstep font-size))
2376          (thickness (* mag
2377                        (ly:output-def-lookup layout 'line-thickness)
2378                        thickness))
2379          ; backward slashes might use slope and point in the other direction!
2380          (dy (* mag (if forward 0.4 -0.4)))
2381          (number-stencil (interpret-markup layout
2382                                            (prepend-alist-chain 'font-encoding 'fetaNumber props)
2383                                            (number->string num)))
2384          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
2385          (center (interval-center (ly:stencil-extent number-stencil Y)))
2386          ; Use the real extents of the slash, not the whole number, because we
2387          ; might translate the slash later on!
2388          (num-y (interval-widen (cons center center) (abs dy)))
2389          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
2390          (slash-stencil (if is-sane
2391                             (ly:make-stencil
2392                              `(draw-line ,thickness
2393                                          ,(car num-x) ,(- (interval-center num-y) dy)
2394                                          ,(cdr num-x) ,(+ (interval-center num-y) dy))
2395                              num-x num-y)
2396                             #f)))
2397 (ly:message "Num: ~a, X-interval: ~a" num num-x)
2398     (if (ly:stencil? slash-stencil)
2399       (begin
2400         ; for some numbers we need to shift the slash/backslash up or down to make
2401         ; the slashed digit look better
2402         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
2403         (set! number-stencil
2404           (ly:stencil-add number-stencil slash-stencil)))
2405       (ly:warning "Unable to create slashed digit ~a" num))
2406     number-stencil))
2407
2408
2409 (define-builtin-markup-command (slashed-digit layout props num)
2410   (integer?)
2411   other
2412   ((font-size 0)
2413    (thickness 1.6))
2414   "
2415 @cindex slashed digits
2416
2417 A feta number, with slash.  This is for use in the context of
2418 figured bass notation.
2419 @lilypond[verbatim,quote]
2420 \\markup {
2421   \\slashed-digit #5
2422   \\hspace #2
2423   \\override #'(thickness . 3)
2424   \\slashed-digit #7
2425 }
2426 @end lilypond"
2427   (slashed-digit-internal layout props num #t font-size thickness))
2428
2429 (define-builtin-markup-command (backslashed-digit layout props num)
2430   (integer?)
2431   other
2432   ((font-size 0)
2433    (thickness 1.6))
2434   "
2435 @cindex backslashed digits
2436
2437 A feta number, with backslash.  This is for use in the context of
2438 figured bass notation.
2439 @lilypond[verbatim,quote]
2440 \\markup {
2441   \\backslashed-digit #5
2442   \\hspace #2
2443   \\override #'(thickness . 3)
2444   \\backslashed-digit #7
2445 }
2446 @end lilypond"
2447   (slashed-digit-internal layout props num #f font-size thickness))
2448
2449 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2450 ;; the note command.
2451 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2452
2453 ;; TODO: better syntax.
2454
2455 (define-builtin-markup-command (note-by-number layout props log dot-count dir)
2456   (number? number? number?)
2457   music
2458   ((font-size 0)
2459    (style '()))
2460   "
2461 @cindex notes within text by log and dot-count
2462
2463 Construct a note symbol, with stem.  By using fractional values for
2464 @var{dir}, you can obtain longer or shorter stems.
2465
2466 @lilypond[verbatim,quote]
2467 \\markup {
2468   \\note-by-number #3 #0 #DOWN
2469   \\hspace #2
2470   \\note-by-number #1 #2 #0.8
2471 }
2472 @end lilypond"
2473   (define (get-glyph-name-candidates dir log style)
2474     (map (lambda (dir-name)
2475      (format "noteheads.~a~a~a" dir-name (min log 2)
2476              (if (and (symbol? style)
2477                       (not (equal? 'default style)))
2478                  (symbol->string style)
2479                  "")))
2480          (list (if (= dir UP) "u" "d")
2481                "s")))
2482
2483   (define (get-glyph-name font cands)
2484     (if (null? cands)
2485      ""
2486      (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
2487          (get-glyph-name font (cdr cands))
2488          (car cands))))
2489
2490   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
2491          (size-factor (magstep font-size))
2492          (stem-length (*  size-factor (max 3 (- log 1))))
2493          (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style)))
2494          (head-glyph (ly:font-get-glyph font head-glyph-name))
2495          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
2496          (stem-thickness (* size-factor 0.13))
2497          (stemy (* dir stem-length))
2498          (attach-off (cons (interval-index
2499                             (ly:stencil-extent head-glyph X)
2500                             (* (sign dir) (car attach-indices)))
2501                            (* (sign dir)        ; fixme, this is inconsistent between X & Y.
2502                               (interval-index
2503                                (ly:stencil-extent head-glyph Y)
2504                                (cdr attach-indices)))))
2505          (stem-glyph (and (> log 0)
2506                           (ly:round-filled-box
2507                            (ordered-cons (car attach-off)
2508                                          (+ (car attach-off)  (* (- (sign dir)) stem-thickness)))
2509                            (cons (min stemy (cdr attach-off))
2510                                  (max stemy (cdr attach-off)))
2511                            (/ stem-thickness 3))))
2512
2513          (dot (ly:font-get-glyph font "dots.dot"))
2514          (dotwid (interval-length (ly:stencil-extent dot X)))
2515          (dots (and (> dot-count 0)
2516                     (apply ly:stencil-add
2517                            (map (lambda (x)
2518                                   (ly:stencil-translate-axis
2519                                    dot (* 2 x dotwid) X))
2520                                 (iota dot-count)))))
2521          (flaggl (and (> log 2)
2522                       (ly:stencil-translate
2523                        (ly:font-get-glyph font
2524                                           (string-append "flags."
2525                                                          (if (> dir 0) "u" "d")
2526                                                          (number->string log)))
2527                        (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy)))))
2528
2529     ; If there is a flag on an upstem and the stem is short, move the dots to avoid the flag.
2530     ; 16th notes get a special case because their flags hang lower than any other flags.
2531     (if (and dots (> dir 0) (> log 2) (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
2532         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
2533     (if flaggl
2534         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
2535     (if (ly:stencil? stem-glyph)
2536         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
2537         (set! stem-glyph head-glyph))
2538     (if (ly:stencil? dots)
2539         (set! stem-glyph
2540               (ly:stencil-add
2541                (ly:stencil-translate-axis
2542                 dots
2543                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
2544                 X)
2545                stem-glyph)))
2546     stem-glyph))
2547
2548 (define-public log2
2549   (let ((divisor (log 2)))
2550     (lambda (z) (inexact->exact (/ (log z) divisor)))))
2551
2552 (define (parse-simple-duration duration-string)
2553   "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list."
2554   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
2555     (if (and match (string=? duration-string (match:substring match 0)))
2556         (let ((len  (match:substring match 1))
2557               (dots (match:substring match 2)))
2558           (list (cond ((string=? len "breve") -1)
2559                       ((string=? len "longa") -2)
2560                       ((string=? len "maxima") -3)
2561                       (else (log2 (string->number len))))
2562                 (if dots (string-length dots) 0)))
2563         (ly:error (_ "not a valid duration string: ~a") duration-string))))
2564
2565 (define-builtin-markup-command (note layout props duration dir)
2566   (string? number?)
2567   music
2568   (note-by-number-markup)
2569   "
2570 @cindex notes within text by string
2571
2572 This produces a note with a stem pointing in @var{dir} direction, with
2573 the @var{duration} for the note head type and augmentation dots.  For
2574 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
2575 a shortened down stem.
2576
2577 @lilypond[verbatim,quote]
2578 \\markup {
2579   \\override #'(style . cross) {
2580     \\note #\"4..\" #UP
2581   }
2582   \\hspace #2
2583   \\note #\"breve\" #0
2584 }
2585 @end lilypond"
2586   (let ((parsed (parse-simple-duration duration)))
2587     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
2588
2589 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2590 ;; translating.
2591 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2592
2593 (define-builtin-markup-command (lower layout props amount arg)
2594   (number? markup?)
2595   align
2596   ()
2597   "
2598 @cindex lowering text
2599
2600 Lower @var{arg} by the distance @var{amount}.
2601 A negative @var{amount} indicates raising; see also @code{\\raise}.
2602
2603 @lilypond[verbatim,quote]
2604 \\markup {
2605   default
2606   \\lower #3 {
2607     three spaces lower
2608   }
2609 }
2610 @end lilypond"
2611   (ly:stencil-translate-axis (interpret-markup layout props arg)
2612                              (- amount) Y))
2613
2614 (define-builtin-markup-command (translate-scaled layout props offset arg)
2615   (number-pair? markup?)
2616   align
2617   ((font-size 0))
2618   "
2619 @cindex translating text
2620 @cindex scaling text
2621
2622 Translate @var{arg} by @var{offset}, scaling the offset by the
2623 @code{font-size}.
2624
2625 @lilypond[verbatim,quote]
2626 \\markup {
2627   \\fontsize #5 {
2628     * \\translate #'(2 . 3) translate
2629     \\hspace #2
2630     * \\translate-scaled #'(2 . 3) translate-scaled
2631   }
2632 }
2633 @end lilypond"
2634   (let* ((factor (magstep font-size))
2635          (scaled (cons (* factor (car offset))
2636                        (* factor (cdr offset)))))
2637     (ly:stencil-translate (interpret-markup layout props arg)
2638                           scaled)))
2639
2640 (define-builtin-markup-command (raise layout props amount arg)
2641   (number? markup?)
2642   align
2643   ()
2644   "
2645 @cindex raising text
2646
2647 Raise @var{arg} by the distance @var{amount}.
2648 A negative @var{amount} indicates lowering, see also @code{\\lower}.
2649
2650 The argument to @code{\\raise} is the vertical displacement amount,
2651 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
2652 raise objects in relation to their surrounding markups.
2653
2654 If the text object itself is positioned above or below the staff, then
2655 @code{\\raise} cannot be used to move it, since the mechanism that
2656 positions it next to the staff cancels any shift made with
2657 @code{\\raise}.  For vertical positioning, use the @code{padding}
2658 and/or @code{extra-offset} properties.
2659
2660 @lilypond[verbatim,quote]
2661 \\markup {
2662   C
2663   \\small
2664   \\bold
2665   \\raise #1.0
2666   9/7+
2667 }
2668 @end lilypond"
2669   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
2670
2671 (define-builtin-markup-command (fraction layout props arg1 arg2)
2672   (markup? markup?)
2673   other
2674   ((font-size 0))
2675   "
2676 @cindex creating text fractions
2677
2678 Make a fraction of two markups.
2679 @lilypond[verbatim,quote]
2680 \\markup {
2681   π ≈
2682   \\fraction 355 113
2683 }
2684 @end lilypond"
2685   (let* ((m1 (interpret-markup layout props arg1))
2686          (m2 (interpret-markup layout props arg2))
2687          (factor (magstep font-size))
2688          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
2689          (padding (* factor 0.2))
2690          (baseline (* factor 0.6))
2691          (offset (* factor 0.75)))
2692     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
2693     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
2694     (let* ((x1 (ly:stencil-extent m1 X))
2695            (x2 (ly:stencil-extent m2 X))
2696            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
2697            ;; should stack mols separately, to maintain LINE on baseline
2698            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
2699       (set! stack
2700             (ly:stencil-aligned-to stack Y CENTER))
2701       (set! stack
2702             (ly:stencil-aligned-to stack X LEFT))
2703       ;; should have EX dimension
2704       ;; empirical anyway
2705       (ly:stencil-translate-axis stack offset Y))))
2706
2707 (define-builtin-markup-command (normal-size-super layout props arg)
2708   (markup?)
2709   font
2710   ((baseline-skip))
2711   "
2712 @cindex setting superscript in standard font size
2713
2714 Set @var{arg} in superscript with a normal font size.
2715
2716 @lilypond[verbatim,quote]
2717 \\markup {
2718   default
2719   \\normal-size-super {
2720     superscript in standard size
2721   }
2722 }
2723 @end lilypond"
2724   (ly:stencil-translate-axis
2725    (interpret-markup layout props arg)
2726    (* 0.5 baseline-skip) Y))
2727
2728 (define-builtin-markup-command (super layout props arg)
2729   (markup?)
2730   font
2731   ((font-size 0)
2732    (baseline-skip))
2733   "
2734 @cindex superscript text
2735
2736 Raising and lowering texts can be done with @code{\\super} and
2737 @code{\\sub}:
2738
2739 @lilypond[verbatim,quote]
2740 \\markup {
2741   E =
2742   \\concat {
2743     mc
2744     \\super
2745     2
2746   }
2747 }
2748 @end lilypond"
2749   (ly:stencil-translate-axis
2750    (interpret-markup
2751     layout
2752     (cons `((font-size . ,(- font-size 3))) props)
2753     arg)
2754    (* 0.5 baseline-skip)
2755    Y))
2756
2757 (define-builtin-markup-command (translate layout props offset arg)
2758   (number-pair? markup?)
2759   align
2760   ()
2761   "
2762 @cindex translating text
2763
2764 This translates an object.  Its first argument is a cons of numbers.
2765
2766 @example
2767 A \\translate #(cons 2 -3) @{ B C @} D
2768 @end example
2769
2770 This moves @q{B C} 2@tie{}spaces to the right, and 3 down, relative to its
2771 surroundings.  This command cannot be used to move isolated scripts
2772 vertically, for the same reason that @code{\\raise} cannot be used for
2773 that.
2774
2775 @lilypond[verbatim,quote]
2776 \\markup {
2777   *
2778   \\translate #'(2 . 3)
2779   \\line { translated two spaces right, three up }
2780 }
2781 @end lilypond"
2782   (ly:stencil-translate (interpret-markup layout props arg)
2783                         offset))
2784
2785 (define-builtin-markup-command (sub layout props arg)
2786   (markup?)
2787   font
2788   ((font-size 0)
2789    (baseline-skip))
2790   "
2791 @cindex subscript text
2792
2793 Set @var{arg} in subscript.
2794
2795 @lilypond[verbatim,quote]
2796 \\markup {
2797   \\concat {
2798     H
2799     \\sub {
2800       2
2801     }
2802     O
2803   }
2804 }
2805 @end lilypond"
2806   (ly:stencil-translate-axis
2807    (interpret-markup
2808     layout
2809     (cons `((font-size . ,(- font-size 3))) props)
2810     arg)
2811    (* -0.5 baseline-skip)
2812    Y))
2813
2814 (define-builtin-markup-command (normal-size-sub layout props arg)
2815   (markup?)
2816   font
2817   ((baseline-skip))
2818   "
2819 @cindex setting subscript in standard font size
2820
2821 Set @var{arg} in subscript, in a normal font size.
2822
2823 @lilypond[verbatim,quote]
2824 \\markup {
2825   default
2826   \\normal-size-sub {
2827     subscript in standard size
2828   }
2829 }
2830 @end lilypond"
2831   (ly:stencil-translate-axis
2832    (interpret-markup layout props arg)
2833    (* -0.5 baseline-skip)
2834    Y))
2835 \f
2836 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2837 ;; brackets.
2838 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2839
2840 (define-builtin-markup-command (hbracket layout props arg)
2841   (markup?)
2842   graphic
2843   ()
2844   "
2845 @cindex placing horizontal brackets around text
2846
2847 Draw horizontal brackets around @var{arg}.
2848
2849 @lilypond[verbatim,quote]
2850 \\markup {
2851   \\hbracket {
2852     \\line {
2853       one two three
2854     }
2855   }
2856 }
2857 @end lilypond"
2858   (let ((th 0.1) ;; todo: take from GROB.
2859         (m (interpret-markup layout props arg)))
2860     (bracketify-stencil m X th (* 2.5 th) th)))
2861
2862 (define-builtin-markup-command (bracket layout props arg)
2863   (markup?)
2864   graphic
2865   ()
2866   "
2867 @cindex placing vertical brackets around text
2868
2869 Draw vertical brackets around @var{arg}.
2870
2871 @lilypond[verbatim,quote]
2872 \\markup {
2873   \\bracket {
2874     \\note #\"2.\" #UP
2875   }
2876 }
2877 @end lilypond"
2878   (let ((th 0.1) ;; todo: take from GROB.
2879         (m (interpret-markup layout props arg)))
2880     (bracketify-stencil m Y th (* 2.5 th) th)))
2881 \f
2882 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2883 ;; Delayed markup evaluation
2884 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2885
2886 (define-builtin-markup-command (page-ref layout props label gauge default)
2887   (symbol? markup? markup?)
2888   other
2889   ()
2890   "
2891 @cindex referencing page numbers in text
2892
2893 Reference to a page number. @var{label} is the label set on the referenced
2894 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
2895 the maximum width of the page number, and @var{default} the value to display
2896 when @var{label} is not found."
2897   (let* ((gauge-stencil (interpret-markup layout props gauge))
2898          (x-ext (ly:stencil-extent gauge-stencil X))
2899          (y-ext (ly:stencil-extent gauge-stencil Y)))
2900     (ly:make-stencil
2901      `(delay-stencil-evaluation
2902        ,(delay (ly:stencil-expr
2903                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
2904                        (label-page (and (list? table) (assoc label table)))
2905                        (page-number (and label-page (cdr label-page)))
2906                        (page-markup (if page-number (format "~a" page-number) default))
2907                        (page-stencil (interpret-markup layout props page-markup))
2908                        (gap (- (interval-length x-ext)
2909                                (interval-length (ly:stencil-extent page-stencil X)))))
2910                   (interpret-markup layout props
2911                                     (markup #:concat (#:hspace gap page-markup)))))))
2912      x-ext
2913      y-ext)))
2914 \f
2915 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2916 ;; Markup list commands
2917 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2918
2919 (define-public (space-lines baseline stils)
2920   (let space-stil ((prev-stil #f)
2921                    (stils stils)
2922                    (result (list)))
2923     (cond ((null? stils)
2924            (reverse! result))
2925           ((not prev-stil)
2926            (space-stil (car stils) (cdr stils) (list (car stils))))
2927           (else
2928            (let* ((stil (car stils))
2929                   (dy (max (- baseline
2930                               (+ (- (interval-bound (ly:stencil-extent prev-stil Y) DOWN))
2931                                  (interval-bound (ly:stencil-extent stil Y) UP)))
2932                            0.0))
2933                   (new-stil (ly:make-stencil
2934                              (ly:stencil-expr stil)
2935                              (ly:stencil-extent stil X)
2936                              (cons (interval-bound (ly:stencil-extent stil Y) DOWN)
2937                                    (+ (interval-bound (ly:stencil-extent stil Y) UP) dy)))))
2938              (space-stil stil (cdr stils) (cons new-stil result)))))))
2939
2940 (define-builtin-markup-list-command (justified-lines layout props args)
2941   (markup-list?)
2942   ((baseline-skip)
2943    wordwrap-internal-markup-list)
2944   "
2945 @cindex justifying lines of text
2946
2947 Like @code{\\justify}, but return a list of lines instead of a single markup.
2948 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
2949 @var{X}@tie{}is the number of staff spaces."
2950   (space-lines baseline-skip
2951                (interpret-markup-list layout props
2952                                       (make-wordwrap-internal-markup-list #t args))))
2953
2954 (define-builtin-markup-list-command (wordwrap-lines layout props args)
2955   (markup-list?)
2956   ((baseline-skip)
2957    wordwrap-internal-markup-list)
2958   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
2959 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
2960 where @var{X} is the number of staff spaces."
2961   (space-lines baseline-skip
2962                (interpret-markup-list layout props
2963                                       (make-wordwrap-internal-markup-list #f args))))
2964
2965 (define-builtin-markup-list-command (column-lines layout props args)
2966   (markup-list?)
2967   ((baseline-skip))
2968   "Like @code{\\column}, but return a list of lines instead of a single markup.
2969 @code{baseline-skip} determines the space between each markup in @var{args}."
2970   (space-lines (chain-assoc-get 'baseline-skip props)
2971                (interpret-markup-list layout props args)))
2972
2973 (define-builtin-markup-list-command (override-lines layout props new-prop args)
2974   (pair? markup-list?)
2975   ()
2976   "Like @code{\\override}, for markup lists."
2977   (interpret-markup-list layout (cons (list new-prop) props) args))