scm/define-markup-commands.scm

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