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