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