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