scm/define-markup-commands.scm

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