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