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