scm/define-markup-commands.scm

   1 ;;;; define-markup-commands.scm -- markup commands
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2000--2007  Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8
   9 ;;; markup commands
  10 ;;;  * each markup function should have a doc string with
  11 ;;     syntax, description and example.
  12
  13 (use-modules (ice-9 regex))
  14
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;; utility functions
  17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18
  19 (define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
  20 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
  21
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;; geometric shapes
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25
  26 (define-builtin-markup-command (draw-line layout props dest)
  27   (number-pair?)
  28   graphic
  29   ((thickness 1))
  30   "
  31 @cindex drawing lines within text
  32
  33 A simple line."
  34   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
  35                thickness))
  36         (x (car dest))
  37         (y (cdr dest)))
  38     (ly:make-stencil
  39      `(draw-line
  40        ,th
  41        0 0
  42        ,x ,y)
  43      (cons (min x 0) (max x 0))
  44      (cons (min y 0) (max y 0)))))
  45
  46 (define-builtin-markup-command (draw-circle layout props radius thickness fill)
  47   (number? number? boolean?)
  48   graphic
  49   ()
  50   "
  51 @cindex drawing circles within text
  52
  53 A circle of radius @var{radius}, thickness @var{thickness} and
  54 optionally filled.
  55
  56 @lilypond[verbatim,quote]
  57 \\markup { \\draw-circle #2 #0.5 ##f \\hspace #2 \\draw-circle #2 #0 ##t }
  58 @end lilypond"
  59   (make-circle-stencil radius thickness fill))
  60
  61 (define-builtin-markup-command (triangle layout props filled)
  62   (boolean?)
  63   graphic
  64   ((thickness 0.1)
  65    (font-size 0)
  66    (baseline-skip 2))
  67   "
  68 @cindex drawing triangles within text
  69
  70 A triangle, either filled or empty.
  71
  72 @lilypond[verbatim,quote]
  73 \\markup { \\triangle ##t \\hspace #2 \\triangle ##f }
  74 @end lilypond"
  75   (let ((ex (* (magstep font-size) 0.8 baseline-skip)))
  76     (ly:make-stencil
  77      `(polygon '(0.0 0.0
  78                      ,ex 0.0
  79                      ,(* 0.5 ex)
  80                      ,(* 0.86 ex))
  81            ,thickness
  82            ,filled)
  83      (cons 0 ex)
  84      (cons 0 (* .86 ex)))))
  85
  86 (define-builtin-markup-command (circle layout props arg)
  87   (markup?)
  88   graphic
  89   ((thickness 1)
  90    (font-size 0)
  91    (circle-padding 0.2))
  92   "
  93 @cindex circling text
  94
  95 Draw a circle around @var{arg}.  Use @code{thickness},
  96 @code{circle-padding} and @code{font-size} properties to determine line
  97 thickness and padding around the markup."
  98   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
  99                thickness))
 100          (pad (* (magstep font-size) circle-padding))
 101          (m (interpret-markup layout props arg)))
 102     (circle-stencil m th pad)))
 103
 104 (define-builtin-markup-command (with-url layout props url arg)
 105   (string? markup?)
 106   graphic
 107   ()
 108   "
 109 @cindex inserting URL links into text
 110
 111 Add a link to URL @var{url} around @var{arg}.  This only works in
 112 the PDF backend.
 113
 114 @lilypond[verbatim,quote]
 115 \\markup {
 116   \\with-url #\"http://lilypond.org/web/\" {
 117     LilyPond ... \\italic { music notation for everyone }
 118   }
 119 }
 120 @end lilypond"
 121   (let* ((stil (interpret-markup layout props arg))
 122          (xextent (ly:stencil-extent stil X))
 123          (yextent (ly:stencil-extent stil Y))
 124          (old-expr (ly:stencil-expr stil))
 125          (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
 126
 127     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
 128
 129 (define-builtin-markup-command (beam layout props width slope thickness)
 130   (number? number? number?)
 131   graphic
 132   ()
 133   "
 134 @cindex drawing beams within text
 135
 136 Create a beam with the specified parameters."
 137   (let* ((y (* slope width))
 138          (yext (cons (min 0 y) (max 0 y)))
 139          (half (/ thickness 2)))
 140
 141     (ly:make-stencil
 142      `(polygon ',(list
 143                   0 (/ thickness -2)
 144                     width (+ (* width slope)  (/ thickness -2))
 145                     width (+ (* width slope)  (/ thickness 2))
 146                     0 (/ thickness 2))
 147                ,(ly:output-def-lookup layout 'blot-diameter)
 148                #t)
 149      (cons 0 width)
 150      (cons (+ (- half) (car yext))
 151            (+ half (cdr yext))))))
 152
 153 (define-builtin-markup-command (underline layout props arg)
 154   (markup?)
 155   music
 156   ((thickness 1))
 157   "
 158 @cindex underlining text
 159
 160 Underline @var{arg}.  Looks at @code{thickness} to determine line
 161 thickness and y offset."
 162   (let* ((thick (* (ly:output-def-lookup layout 'line-thickness)
 163                    thickness))
 164          (markup (interpret-markup layout props arg))
 165          (x1 (car (ly:stencil-extent markup X)))
 166          (x2 (cdr (ly:stencil-extent markup X)))
 167          (y (* thick -2))
 168          (line (ly:make-stencil
 169                 `(draw-line ,thick ,x1 ,y ,x2 ,y)
 170                 (cons (min x1 0) (max x2 0))
 171                 (cons thick thick))))
 172     (ly:stencil-add markup line)))
 173
 174 (define-builtin-markup-command (box layout props arg)
 175   (markup?)
 176   font
 177   ((thickness 1)
 178    (font-size 0)
 179    (box-padding 0.2))
 180   "
 181 @cindex enclosing text within a box
 182
 183 Draw a box round @var{arg}.  Looks at @code{thickness},
 184 @code{box-padding} and @code{font-size} properties to determine line
 185 thickness and padding around the markup."
 186   (let* ((th (* (ly:output-def-lookup layout 'line-thickness)
 187                 thickness))
 188          (pad (* (magstep font-size) box-padding))
 189          (m (interpret-markup layout props arg)))
 190     (box-stencil m th pad)))
 191
 192 (define-builtin-markup-command (filled-box layout props xext yext blot)
 193   (number-pair? number-pair? number?)
 194   graphic
 195   ()
 196   "
 197 @cindex drawing solid boxes within text
 198 @cindex drawing boxes with rounded corners
 199
 200 Draw a box with rounded corners of dimensions @var{xext} and
 201 @var{yext}.  For example,
 202 @verbatim
 203 \\filled-box #'(-.3 . 1.8) #'(-.3 . 1.8) #0
 204 @end verbatim
 205 creates a box extending horizontally from -0.3 to 1.8 and
 206 vertically from -0.3 up to 1.8, with corners formed from a
 207 circle of diameter@tie{}0 (i.e. sharp corners).
 208
 209 @lilypond[verbatim,quote]
 210 \\markup {
 211   \\filled-box #'(0 . 4) #'(0 . 4) #0
 212   \\filled-box #'(0 . 2) #'(-4 . 2) #0.4
 213   \\filled-box #'(1 . 8) #'(0 . 7) #0.2
 214   \\with-color #white \\filled-box #'(-4.5 . -2.5) #'(3.5 . 5.5) #0.7
 215 }
 216 @end lilypond"
 217   (ly:round-filled-box
 218    xext yext blot))
 219
 220 (define-builtin-markup-command (rounded-box layout props arg)
 221   (markup?)
 222   graphic
 223   ((thickness 1)
 224    (corner-radius 1)
 225    (font-size 0)
 226    (box-padding 0.5))
 227   "@cindex enclosing text in a bow with rounded corners
 228    @cindex drawing boxes with rounded corners around text
 229 Draw a box with rounded corners around @var{arg}.  Looks at @code{thickness},
 230 @code{box-padding} and @code{font-size} properties to determine line
 231 thickness and padding around the markup; the @code{corner-radius} property
 232 makes possible to define another shape for the corners (default is 1).
 233
 234 @lilypond[quote,verbatim,fragment,relative=2]
 235 c^\\markup{ \\rounded-box Overtura }
 236 c,8. c16 c4 r
 237 @end lilypond"
 238   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 239                thickness))
 240         (pad (* (magstep font-size) box-padding))
 241         (m (interpret-markup layout props arg)))
 242     (ly:stencil-add (rounded-box-stencil m th pad corner-radius)
 243                     m)))
 244
 245 (define-builtin-markup-command (rotate layout props ang arg)
 246   (number? markup?)
 247   align
 248   ()
 249   "
 250 @cindex rotating text
 251
 252 Rotate object with @var{ang} degrees around its center."
 253   (let* ((stil (interpret-markup layout props arg)))
 254     (ly:stencil-rotate stil ang 0 0)))
 255
 256 (define-builtin-markup-command (whiteout layout props arg)
 257   (markup?)
 258   other
 259   ()
 260   "
 261 @cindex adding a white background to text
 262
 263 Provide a white background for @var{arg}."
 264   (stencil-whiteout (interpret-markup layout props arg)))
 265
 266 (define-builtin-markup-command (pad-markup layout props padding arg)
 267   (number? markup?)
 268   align
 269   ()
 270   "
 271 @cindex padding text
 272 @cindex putting space around text
 273
 274 Add space around a markup object."
 275   (let*
 276       ((stil (interpret-markup layout props arg))
 277        (xext (ly:stencil-extent stil X))
 278        (yext (ly:stencil-extent stil Y)))
 279
 280     (ly:make-stencil
 281      (ly:stencil-expr stil)
 282      (interval-widen xext padding)
 283      (interval-widen yext padding))))
 284
 285 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 286 ;; space
 287 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 288
 289 (define-builtin-markup-command (strut layout props)
 290   ()
 291   other
 292   ()
 293   "
 294 @cindex creating vertical spaces in text
 295
 296 Create a box of the same height as the space in the current font."
 297   (let ((m (ly:text-interface::interpret-markup layout props " ")))
 298     (ly:make-stencil (ly:stencil-expr m)
 299                      '(0 . 0)
 300                      (ly:stencil-extent m X)
 301                      )))
 302
 303 ;; todo: fix negative space
 304 (define-builtin-markup-command (hspace layout props amount)
 305   (number?)
 306   align
 307   ()
 308   "
 309 @cindex creating horizontal spaces in text
 310
 311 This produces a invisible object taking horizontal space.  For example,
 312
 313 @example
 314 \\markup @{ A \\hspace #2.0 B @}
 315 @end example
 316
 317 @noindent
 318 puts extra space between A and@tie{}B, on top of the space that is
 319 normally inserted before elements on a line."
 320   (if (> amount 0)
 321       (ly:make-stencil "" (cons 0 amount) '(-1 . 1))
 322       (ly:make-stencil "" (cons amount amount) '(-1 . 1))))
 323
 324
 325 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 326 ;; importing graphics.
 327 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 328
 329 (define-builtin-markup-command (stencil layout props stil)
 330   (ly:stencil?)
 331   other
 332   ()
 333   "
 334 @cindex importing stencils into text
 335
 336 Use a stencil as markup."
 337   stil)
 338
 339 (define bbox-regexp
 340   (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
 341
 342 (define (get-postscript-bbox string)
 343   "Extract the bbox from STRING, or return #f if not present."
 344   (let*
 345       ((match (regexp-exec bbox-regexp string)))
 346
 347     (if match
 348         (map (lambda (x)
 349                (string->number (match:substring match x)))
 350              (cdr (iota 5)))
 351
 352         #f)))
 353
 354 (define-builtin-markup-command (epsfile layout props axis size file-name)
 355   (number? number? string?)
 356   graphic
 357   ()
 358   "
 359 @cindex inlining an Encapsulated PostScript image
 360
 361 Inline an EPS image.  The image is scaled along @var{axis} to
 362 @var{size}.
 363
 364 @lilypond[verbatim,quote]
 365 \\markup {
 366   \\general-align #Y #DOWN {
 367     \\epsfile #X #20 #\"context-example.eps\"
 368     \\epsfile #Y #20 #\"context-example.eps\"
 369   }
 370 }
 371 @end lilypond"
 372   (if (ly:get-option 'safe)
 373       (interpret-markup layout props "not allowed in safe")
 374       (eps-file->stencil axis size file-name)
 375       ))
 376
 377 (define-builtin-markup-command (postscript layout props str)
 378   (string?)
 379   graphic
 380   ()
 381   "
 382 @cindex inserting PostScript directly into text
 383
 384 This inserts @var{str} directly into the output as a PostScript
 385 command string.  Due to technicalities of the output backends,
 386 different scales should be used for the @TeX{} and PostScript backend,
 387 selected with @code{-f}.
 388
 389 For the @TeX{} backend, the following string prints a rotated text
 390
 391 @example
 392 0 0 moveto /ecrm10 findfont
 393 1.75 scalefont setfont 90 rotate (hello) show
 394 @end example
 395
 396 @noindent
 397 The magical constant 1.75 scales from LilyPond units (staff spaces) to
 398 @TeX{} dimensions.
 399
 400 For the postscript backend, use the following
 401
 402 @example
 403 gsave /ecrm10 findfont
 404  10.0 output-scale div
 405  scalefont setfont 90 rotate (hello) show grestore
 406 @end example
 407
 408 @lilypond[verbatim,quote]
 409 eyeglassesps = #\"
 410   0.15 setlinewidth
 411   -0.9 0 translate
 412   1.1 1.1 scale
 413   1.2 0.7 moveto
 414   0.7 0.7 0.5 0 361 arc
 415   stroke
 416   2.20 0.70 0.50 0 361 arc
 417   stroke
 418   1.45 0.85 0.30 0 180 arc
 419   stroke
 420   0.20 0.70 moveto
 421   0.80 2.00 lineto
 422   0.92 2.26 1.30 2.40 1.15 1.70 curveto
 423   stroke
 424   2.70 0.70 moveto
 425   3.30 2.00 lineto
 426   3.42 2.26 3.80 2.40 3.65 1.70 curveto
 427   stroke\"
 428
 429 eyeglasses = \\markup {
 430   \\with-dimensions #'(0 . 4.4) #'(0 . 2.5)
 431   \\postscript #eyeglassesps
 432 }
 433
 434 \\relative c'' { c2^\\eyeglasses a_\\eyeglasses }
 435 @end lilypond"
 436   ;; FIXME
 437   (ly:make-stencil
 438    (list 'embedded-ps
 439          (format "
 440 gsave currentpoint translate
 441 0.1 setlinewidth
 442  ~a
 443 grestore
 444 "
 445                  str))
 446    '(0 . 0) '(0 . 0)))
 447
 448 (define-builtin-markup-command (score layout props score)
 449   (ly:score?)
 450   music
 451   ()
 452   "
 453 @cindex inserting music into text
 454
 455 Inline an image of music.
 456
 457 @lilypond[verbatim,quote]
 458 \\markup {
 459   \\score {
 460     \\new PianoStaff <<
 461       \\new Staff \\relative c' {
 462         \\key f \\major
 463         \\time 3/4
 464         \\mark \\markup { Allegro }
 465         f2\\p( a4)
 466         c2( a4)
 467         bes2( g'4)
 468         f8( e) e4 r
 469       }
 470       \\new Staff \\relative c {
 471         \\clef bass
 472         \\key f \\major
 473         \\time 3/4
 474         f8( a c a c a
 475         f c' es c es c)
 476         f,( bes d bes d bes)
 477         f( g bes g bes g)
 478       }
 479     >>
 480     \\layout {
 481       indent = 0.0\\cm
 482       \\context {
 483         \\Score
 484         \\override RehearsalMark #'break-align-symbols =
 485           #'(time-signature key-signature)
 486         \\override RehearsalMark #'self-alignment-X = #LEFT
 487       }
 488       \\context {
 489         \\Staff
 490         \\override TimeSignature #'break-align-anchor-alignment = #LEFT
 491       }
 492     }
 493   }
 494 }
 495 @end lilypond"
 496   (let* ((output (ly:score-embedded-format score layout)))
 497
 498     (if (ly:music-output? output)
 499         (paper-system-stencil
 500          (vector-ref (ly:paper-score-paper-systems output) 0))
 501         (begin
 502           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
 503           empty-stencil))))
 504
 505 (define-builtin-markup-command (null layout props)
 506   ()
 507   other
 508   ()
 509   "
 510 @cindex creating empty text objects
 511
 512 An empty markup with extents of a single point."
 513   point-stencil)
 514
 515 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 516 ;; basic formatting.
 517 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 518
 519 (define-builtin-markup-command (simple layout props str)
 520   (string?)
 521   font
 522   ()
 523   "
 524 @cindex simple text strings
 525
 526 A simple text string; @code{\\markup @{ foo @}} is equivalent with
 527 @code{\\markup @{ \\simple #\"foo\" @}}."
 528   (interpret-markup layout props str))
 529
 530 (define-builtin-markup-command (tied-lyric layout props str)
 531   (string?)
 532   music
 533   ()
 534   "
 535 @cindex simple text strings with tie characters
 536
 537 Like simple-markup, but use tie characters for @q{~} tilde symbols."
 538   (if (string-contains str "~")
 539       (let*
 540           ((parts (string-split str #\~))
 541            (tie-str (ly:wide-char->utf-8 #x203f))
 542            (joined  (list-join parts tie-str))
 543            (join-stencil (interpret-markup layout props tie-str))
 544            )
 545
 546         (interpret-markup layout
 547                           (prepend-alist-chain
 548                            'word-space
 549                            (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
 550                            props)
 551                           (make-line-markup joined)))
 552                            ;(map (lambda (s) (interpret-markup layout props s)) parts))
 553       (interpret-markup layout props str)))
 554
 555 (define-public empty-markup
 556   (make-simple-markup ""))
 557
 558 ;; helper for justifying lines.
 559 (define (get-fill-space word-count line-width text-widths)
 560   "Calculate the necessary paddings between each two adjacent texts.
 561         The lengths of all texts are stored in @var{text-widths}.
 562         The normal formula for the padding between texts a and b is:
 563         padding = line-width/(word-count - 1) - (length(a) + length(b))/2
 564         The first and last padding have to be calculated specially using the
 565         whole length of the first or last text.
 566         Return a list of paddings."
 567   (cond
 568    ((null? text-widths) '())
 569
 570    ;; special case first padding
 571    ((= (length text-widths) word-count)
 572     (cons
 573      (- (- (/ line-width (1- word-count)) (car text-widths))
 574         (/ (car (cdr text-widths)) 2))
 575      (get-fill-space word-count line-width (cdr text-widths))))
 576    ;; special case last padding
 577    ((= (length text-widths) 2)
 578     (list (- (/ line-width (1- word-count))
 579              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
 580    (else
 581     (cons
 582      (- (/ line-width (1- word-count))
 583         (/ (+ (car text-widths) (car (cdr text-widths))) 2))
 584      (get-fill-space word-count line-width (cdr text-widths))))))
 585
 586 (define-builtin-markup-command (fill-line layout props markups)
 587   (markup-list?)
 588   align
 589   ((text-direction RIGHT)
 590    (word-space 1)
 591    (line-width #f))
 592   "Put @var{markups} in a horizontal line of width @var{line-width}.
 593 The markups are spaced or flushed to fill the entire line.
 594 If there are no arguments, return an empty stencil."
 595
 596   (let* ((orig-stencils (interpret-markup-list layout props markups))
 597          (stencils
 598           (map (lambda (stc)
 599                  (if (ly:stencil-empty? stc)
 600                      point-stencil
 601                      stc)) orig-stencils))
 602          (text-widths
 603           (map (lambda (stc)
 604                  (if (ly:stencil-empty? stc)
 605                      0.0
 606                      (interval-length (ly:stencil-extent stc X))))
 607                stencils))
 608          (text-width (apply + text-widths))
 609          (word-count (length stencils))
 610          (prop-line-width (chain-assoc-get 'line-width props #f))
 611          (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
 612          (fill-space
 613                 (cond
 614                         ((= word-count 1)
 615                                 (list
 616                                         (/ (- line-width text-width) 2)
 617                                         (/ (- line-width text-width) 2)))
 618                         ((= word-count 2)
 619                                 (list
 620                                         (- line-width text-width)))
 621                         (else
 622                                 (get-fill-space word-count line-width text-widths))))
 623          (fill-space-normal
 624           (map (lambda (x)
 625                  (if (< x word-space)
 626                      word-space
 627                      x))
 628                fill-space))
 629
 630          (line-stencils (if (= word-count 1)
 631                             (list
 632                              point-stencil
 633                              (car stencils)
 634                              point-stencil)
 635                             stencils)))
 636
 637     (if (= text-direction LEFT)
 638         (set! line-stencils (reverse line-stencils)))
 639
 640     (if (null? (remove ly:stencil-empty? orig-stencils))
 641         empty-stencil
 642         (stack-stencils-padding-list X
 643                                      RIGHT fill-space-normal line-stencils))))
 644
 645 (define-builtin-markup-command (line layout props args)
 646   (markup-list?)
 647   align
 648   ((word-space)
 649    (text-direction RIGHT))
 650   "Put @var{args} in a horizontal line.  The property @code{word-space}
 651 determines the space between each markup in @var{args}."
 652   (let ((stencils (interpret-markup-list layout props args)))
 653     (if (= text-direction LEFT)
 654         (set! stencils (reverse stencils)))
 655     (stack-stencil-line
 656      word-space
 657      (remove ly:stencil-empty? stencils))))
 658
 659 (define-builtin-markup-command (concat layout props args)
 660   (markup-list?)
 661   align
 662   ()
 663   "
 664 @cindex concatenating text
 665 @cindex ligatures in text
 666
 667 Concatenate @var{args} in a horizontal line, without spaces inbetween.
 668 Strings and simple markups are concatenated on the input level, allowing
 669 ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
 670 equivalent to @code{\"fi\"}."
 671   (define (concat-string-args arg-list)
 672     (fold-right (lambda (arg result-list)
 673                   (let ((result (if (pair? result-list)
 674                                     (car result-list)
 675                                   '())))
 676                     (if (and (pair? arg) (eqv? (car arg) simple-markup))
 677                       (set! arg (cadr arg)))
 678                     (if (and (string? result) (string? arg))
 679                         (cons (string-append arg result) (cdr result-list))
 680                       (cons arg result-list))))
 681                 '()
 682                 arg-list))
 683
 684   (interpret-markup layout
 685                     (prepend-alist-chain 'word-space 0 props)
 686                     (make-line-markup (if (markup-command-list? args)
 687                                           args
 688                                           (concat-string-args args)))))
 689
 690 (define (wordwrap-stencils stencils
 691                            justify base-space line-width text-dir)
 692   "Perform simple wordwrap, return stencil of each line."
 693   (define space (if justify
 694                     ;; justify only stretches lines.
 695                     (* 0.7 base-space)
 696                     base-space))
 697   (define (take-list width space stencils
 698                      accumulator accumulated-width)
 699     "Return (head-list . tail) pair, with head-list fitting into width"
 700     (if (null? stencils)
 701         (cons accumulator stencils)
 702         (let* ((first (car stencils))
 703                (first-wid (cdr (ly:stencil-extent (car stencils) X)))
 704                (newwid (+ space first-wid accumulated-width)))
 705           (if (or (null? accumulator)
 706                   (< newwid width))
 707               (take-list width space
 708                          (cdr stencils)
 709                          (cons first accumulator)
 710                          newwid)
 711               (cons accumulator stencils)))))
 712   (let loop ((lines '())
 713              (todo stencils))
 714     (let* ((line-break (take-list line-width space todo
 715                                   '() 0.0))
 716            (line-stencils (car line-break))
 717            (space-left (- line-width
 718                           (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
 719                                         line-stencils))))
 720            (line-word-space (cond ((not justify) space)
 721                                   ;; don't stretch last line of paragraph.
 722                                   ;; hmmm . bug - will overstretch the last line in some case.
 723                                   ((null? (cdr line-break))
 724                                    base-space)
 725                                   ((null? line-stencils) 0.0)
 726                                   ((null? (cdr line-stencils)) 0.0)
 727                                   (else (/ space-left (1- (length line-stencils))))))
 728            (line (stack-stencil-line line-word-space
 729                                      (if (= text-dir RIGHT)
 730                                          (reverse line-stencils)
 731                                          line-stencils))))
 732       (if (pair? (cdr line-break))
 733           (loop (cons line lines)
 734                 (cdr line-break))
 735           (begin
 736             (if (= text-dir LEFT)
 737                 (set! line
 738                       (ly:stencil-translate-axis
 739                        line
 740                        (- line-width (interval-end (ly:stencil-extent line X)))
 741                        X)))
 742             (reverse (cons line lines)))))))
 743
 744 (define-builtin-markup-list-command (wordwrap-internal layout props justify args)
 745   (boolean? markup-list?)
 746   ((line-width #f)
 747    (word-space)
 748    (text-direction RIGHT))
 749   "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
 750   (wordwrap-stencils (remove ly:stencil-empty?
 751                              (interpret-markup-list layout props args))
 752                      justify
 753                      word-space
 754                      (or line-width
 755                          (ly:output-def-lookup layout 'line-width))
 756                      text-direction))
 757
 758 (define-builtin-markup-command (justify layout props args)
 759   (markup-list?)
 760   align
 761   ((baseline-skip)
 762    wordwrap-internal-markup-list)
 763   "
 764 @cindex justifying text
 765
 766 Like wordwrap, but with lines stretched to justify the margins.
 767 Use @code{\\override #'(line-width . @var{X})} to set the line width;
 768 @var{X}@tie{}is the number of staff spaces."
 769   (stack-lines DOWN 0.0 baseline-skip
 770                (wordwrap-internal-markup-list layout props #t args)))
 771
 772 (define-builtin-markup-command (wordwrap layout props args)
 773   (markup-list?)
 774   align
 775   ((baseline-skip)
 776    wordwrap-internal-markup-list)
 777   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
 778 the line width, where @var{X} is the number of staff spaces."
 779   (stack-lines DOWN 0.0 baseline-skip
 780                (wordwrap-internal-markup-list layout props #f args)))
 781
 782 (define-builtin-markup-list-command (wordwrap-string-internal layout props justify arg)
 783   (boolean? string?)
 784   ((line-width)
 785    (word-space)
 786    (text-direction RIGHT))
 787   "Internal markup list command used to define @code{\\justify-string} and
 788 @code{\\wordwrap-string}."
 789   (let* ((para-strings (regexp-split
 790                         (string-regexp-substitute
 791                          "\r" "\n"
 792                          (string-regexp-substitute "\r\n" "\n" arg))
 793                         "\n[ \t\n]*\n[ \t\n]*"))
 794          (list-para-words (map (lambda (str)
 795                                  (regexp-split str "[ \t\n]+"))
 796                                para-strings))
 797          (para-lines (map (lambda (words)
 798                             (let* ((stencils
 799                                     (remove ly:stencil-empty?
 800                                             (map (lambda (x)
 801                                                    (interpret-markup layout props x))
 802                                                  words))))
 803                               (wordwrap-stencils stencils
 804                                                  justify word-space
 805                                                  line-width text-direction)))
 806                           list-para-words)))
 807     (apply append para-lines)))
 808
 809 (define-builtin-markup-command (wordwrap-string layout props arg)
 810   (string?)
 811   align
 812   ((baseline-skip)
 813    wordwrap-string-internal-markup-list)
 814   "Wordwrap a string.  Paragraphs may be separated with double newlines."
 815   (stack-lines DOWN 0.0 baseline-skip
 816                (wordwrap-string-internal-markup-list layout props #f arg)))
 817
 818 (define-builtin-markup-command (justify-string layout props arg)
 819   (string?)
 820   align
 821   ((baseline-skip)
 822    wordwrap-string-internal-markup-list)
 823   "Justify a string.  Paragraphs may be separated with double newlines"
 824   (stack-lines DOWN 0.0 baseline-skip
 825                (wordwrap-string-internal-markup-list layout props #t arg)))
 826
 827 (define-builtin-markup-command (wordwrap-field layout props symbol)
 828   (symbol?)
 829   align
 830   ()
 831   "Wordwrap the data which has been assigned to @var{symbol}."
 832   (let* ((m (chain-assoc-get symbol props)))
 833     (if (string? m)
 834         (wordwrap-string-markup layout props m)
 835         empty-stencil)))
 836
 837 (define-builtin-markup-command (justify-field layout props symbol)
 838   (symbol?)
 839   align
 840   ()
 841   "Justify the data which has been assigned to @var{symbol}."
 842   (let* ((m (chain-assoc-get symbol props)))
 843     (if (string? m)
 844         (justify-string-markup layout props m)
 845         empty-stencil)))
 846
 847 (define-builtin-markup-command (combine layout props m1 m2)
 848   (markup? markup?)
 849   align
 850   ()
 851   "
 852 @cindex merging text
 853
 854 Print two markups on top of each other.
 855 @lilypond[verbatim,quote]
 856 \\markup {
 857   \\fontsize #5
 858   \\override #'(thickness . 2)
 859   \\combine \\draw-line #'(0 . 4) \\arrow-head #Y #DOWN ##f
 860 }
 861 @end lilypond"
 862   (let* ((s1 (interpret-markup layout props m1))
 863          (s2 (interpret-markup layout props m2)))
 864     (ly:stencil-add s1 s2)))
 865
 866 ;;
 867 ;; TODO: should extract baseline-skip from each argument somehow..
 868 ;;
 869 (define-builtin-markup-command (column layout props args)
 870   (markup-list?)
 871   align
 872   ((baseline-skip))
 873   "
 874 @cindex stacking text in a column
 875
 876 Stack the markups in @var{args} vertically.  The property
 877 @code{baseline-skip} determines the space between each markup in @var{args}."
 878   (let ((arg-stencils (interpret-markup-list layout props args)))
 879     (stack-lines -1 0.0 baseline-skip
 880                  (remove ly:stencil-empty? arg-stencils))))
 881
 882 (define-builtin-markup-command (dir-column layout props args)
 883   (markup-list?)
 884   align
 885   ((direction)
 886    (baseline-skip))
 887   "
 888 @cindex changing direction of text columns
 889
 890 Make a column of args, going up or down, depending on the setting
 891 of the @code{#'direction} layout property."
 892   (stack-lines (if (number? direction) direction -1)
 893                0.0
 894                baseline-skip
 895                (interpret-markup-list layout props args)))
 896
 897 (define-builtin-markup-command (center-align layout props args)
 898   (markup-list?)
 899   align
 900   ((baseline-skip))
 901   "
 902 @cindex centering a column of text
 903
 904 Put @code{args} in a centered column."
 905   (let* ((mols (interpret-markup-list layout props args))
 906          (cmols (map (lambda (x) (ly:stencil-aligned-to x X CENTER)) mols)))
 907     (stack-lines -1 0.0 baseline-skip cmols)))
 908
 909 (define-builtin-markup-command (vcenter layout props arg)
 910   (markup?)
 911   align
 912   ()
 913   "
 914 @cindex vertically centering text
 915
 916 Align @code{arg} to its Y@tie{}center."
 917   (let* ((mol (interpret-markup layout props arg)))
 918     (ly:stencil-aligned-to mol Y CENTER)))
 919
 920 (define-builtin-markup-command (hcenter layout props arg)
 921   (markup?)
 922   align
 923   ()
 924   "
 925 @cindex horizontally centering text
 926
 927 Align @code{arg} to its X@tie{}center."
 928   (let* ((mol (interpret-markup layout props arg)))
 929     (ly:stencil-aligned-to mol X CENTER)))
 930
 931 (define-builtin-markup-command (right-align layout props arg)
 932   (markup?)
 933   align
 934   ()
 935   "
 936 @cindex right aligning text
 937
 938 Align @var{arg} on its right edge."
 939   (let* ((m (interpret-markup layout props arg)))
 940     (ly:stencil-aligned-to m X RIGHT)))
 941
 942 (define-builtin-markup-command (left-align layout props arg)
 943   (markup?)
 944   align
 945   ()
 946   "
 947 @cindex left aligning text
 948
 949 Align @var{arg} on its left edge."
 950   (let* ((m (interpret-markup layout props arg)))
 951     (ly:stencil-aligned-to m X LEFT)))
 952
 953 (define-builtin-markup-command (general-align layout props axis dir arg)
 954   (integer? number? markup?)
 955   align
 956   ()
 957   "
 958 @cindex controlling general text alignment
 959
 960 Align @var{arg} in @var{axis} direction to the @var{dir} side."
 961   (let* ((m (interpret-markup layout props arg)))
 962     (ly:stencil-aligned-to m axis dir)))
 963
 964 (define-builtin-markup-command (halign layout props dir arg)
 965   (number? markup?)
 966   align
 967   ()
 968   "
 969 @cindex setting horizontal text alignment
 970
 971 Set horizontal alignment.  If @var{dir} is @code{-1}, then it is
 972 left-aligned, while @code{+1} is right.  Values inbetween interpolate
 973 alignment accordingly."
 974   (let* ((m (interpret-markup layout props arg)))
 975     (ly:stencil-aligned-to m X dir)))
 976
 977 (define-builtin-markup-command (with-dimensions layout props x y arg)
 978   (number-pair? number-pair? markup?)
 979   other
 980   ()
 981   "
 982 @cindex setting extent of text objects
 983
 984 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
 985   (let* ((m (interpret-markup layout props arg)))
 986     (ly:make-stencil (ly:stencil-expr m) x y)))
 987
 988 (define-builtin-markup-command (pad-around layout props amount arg)
 989   (number? markup?)
 990   align
 991   ()
 992   "Add padding @var{amount} all around @var{arg}."
 993   (let* ((m (interpret-markup layout props arg))
 994          (x (ly:stencil-extent m X))
 995          (y (ly:stencil-extent m Y)))
 996     (ly:make-stencil (ly:stencil-expr m)
 997                      (interval-widen x amount)
 998                      (interval-widen y amount))))
 999
1000 (define-builtin-markup-command (pad-x layout props amount arg)
1001   (number? markup?)
1002   align
1003   ()
1004   "
1005 @cindex padding text horizontally
1006
1007 Add padding @var{amount} around @var{arg} in the X@tie{}direction."
1008   (let* ((m (interpret-markup layout props arg))
1009          (x (ly:stencil-extent m X))
1010          (y (ly:stencil-extent m Y)))
1011     (ly:make-stencil (ly:stencil-expr m)
1012                      (interval-widen x amount)
1013                      y)))
1014
1015 (define-builtin-markup-command (put-adjacent layout props arg1 axis dir arg2)
1016   (markup? integer? ly:dir? markup?)
1017   align
1018   ()
1019   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1020   (let ((m1 (interpret-markup layout props arg1))
1021         (m2 (interpret-markup layout props arg2)))
1022     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1023
1024 (define-builtin-markup-command (transparent layout props arg)
1025   (markup?)
1026   other
1027   ()
1028   "Make the argument transparent."
1029   (let* ((m (interpret-markup layout props arg))
1030          (x (ly:stencil-extent m X))
1031          (y (ly:stencil-extent m Y)))
1032     (ly:make-stencil "" x y)))
1033
1034 (define-builtin-markup-command (pad-to-box layout props x-ext y-ext arg)
1035   (number-pair? number-pair? markup?)
1036   align
1037   ()
1038   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space."
1039   (let* ((m (interpret-markup layout props arg))
1040          (x (ly:stencil-extent m X))
1041          (y (ly:stencil-extent m Y)))
1042     (ly:make-stencil (ly:stencil-expr m)
1043                      (interval-union x-ext x)
1044                      (interval-union y-ext y))))
1045
1046 (define-builtin-markup-command (hcenter-in layout props length arg)
1047   (number? markup?)
1048   align
1049   ()
1050   "Center @var{arg} horizontally within a box of extending
1051 @var{length}/2 to the left and right."
1052   (interpret-markup layout props
1053                     (make-pad-to-box-markup
1054                      (cons (/ length -2) (/ length 2))
1055                      '(0 . 0)
1056                      (make-hcenter-markup arg))))
1057
1058 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1059 ;; property
1060 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1061
1062 (define-builtin-markup-command (fromproperty layout props symbol)
1063   (symbol?)
1064   other
1065   ()
1066   "Read the @var{symbol} from property settings, and produce a stencil
1067 from the markup contained within.  If @var{symbol} is not defined, it
1068 returns an empty markup."
1069   (let ((m (chain-assoc-get symbol props)))
1070     (if (markup? m)
1071         (interpret-markup layout props m)
1072         empty-stencil)))
1073
1074 (define-builtin-markup-command (on-the-fly layout props procedure arg)
1075   (symbol? markup?)
1076   other
1077   ()
1078   "Apply the @var{procedure} markup command to @var{arg}.
1079 @var{procedure} should take a single argument."
1080   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
1081     (set-object-property! anonymous-with-signature
1082                           'markup-signature
1083                           (list markup?))
1084     (interpret-markup layout props (list anonymous-with-signature arg))))
1085
1086 (define-builtin-markup-command (override layout props new-prop arg)
1087   (pair? markup?)
1088   other
1089   ()
1090   "
1091 @cindex overriding properties within text markup
1092
1093 Add the first argument in to the property list.  Properties may be
1094 any sort of property supported by @rinternals{font-interface} and
1095 @rinternals{text-interface}, for example
1096
1097 @example
1098 \\override #'(font-family . married) \"bla\"
1099 @end example"
1100   (interpret-markup layout (cons (list new-prop) props) arg))
1101
1102 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1103 ;; files
1104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1105
1106 (define-builtin-markup-command (verbatim-file layout props name)
1107   (string?)
1108   other
1109   ()
1110   "Read the contents of a file, and include it verbatim.
1111
1112 @lilypond[verbatim,quote]
1113 \\markup \\verbatim-file #\"simple.ly\"
1114 @end lilypond"
1115   (interpret-markup layout props
1116                     (if  (ly:get-option 'safe)
1117                          "verbatim-file disabled in safe mode"
1118                          (let* ((str (ly:gulp-file name))
1119                                 (lines (string-split str #\nl)))
1120                            (make-typewriter-markup
1121                             (make-column-markup lines))))))
1122
1123 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1124 ;; fonts.
1125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1126
1127 (define-builtin-markup-command (bigger layout props arg)
1128   (markup?)
1129   font
1130   ()
1131   "Increase the font size relative to current setting."
1132   (interpret-markup layout props
1133    `(,fontsize-markup 1 ,arg)))
1134
1135 (define-builtin-markup-command (smaller layout props arg)
1136   (markup?)
1137   font
1138   ()
1139   "Decrease the font size relative to current setting."
1140   (interpret-markup layout props
1141    `(,fontsize-markup -1 ,arg)))
1142
1143 (define-builtin-markup-command larger
1144   (markup?)
1145   font
1146   bigger-markup)
1147
1148 (define-builtin-markup-command (finger layout props arg)
1149   (markup?)
1150   font
1151   ()
1152   "Set the argument as small numbers.
1153 @lilypond[verbatim,quote]
1154 \\markup \\finger { 1 2 3 4 5 }
1155 @end lilypond"
1156   (interpret-markup layout
1157                     (cons '((font-size . -5) (font-encoding . fetaNumber)) props)
1158                     arg))
1159
1160 (define-builtin-markup-command (fontsize layout props increment arg)
1161   (number? markup?)
1162   font
1163   ((font-size 0)
1164    (word-space 1)
1165    (baseline-skip 2))
1166   "Add @var{increment} to the font-size.  Adjust baseline skip accordingly."
1167   (let ((entries (list
1168                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
1169                   (cons 'word-space (* word-space (magstep increment)))
1170                   (cons 'font-size (+ font-size increment)))))
1171     (interpret-markup layout (cons entries props) arg)))
1172
1173 (define-builtin-markup-command (magnify layout props sz arg)
1174   (number? markup?)
1175   font
1176   ()
1177   "
1178 @cindex magnifying text
1179
1180 Set the font magnification for its argument.  In the following
1181 example, the middle@tie{}A is 10% larger:
1182
1183 @example
1184 A \\magnify #1.1 @{ A @} A
1185 @end example
1186
1187 Note: Magnification only works if a font name is explicitly selected.
1188 Use @code{\\fontsize} otherwise."
1189   (interpret-markup
1190    layout
1191    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
1192    arg))
1193
1194 (define-builtin-markup-command (bold layout props arg)
1195   (markup?)
1196   font
1197   ()
1198   "Switch to bold font-series."
1199   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
1200
1201 (define-builtin-markup-command (sans layout props arg)
1202   (markup?)
1203   font
1204   ()
1205   "Switch to the sans serif family."
1206   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
1207
1208 (define-builtin-markup-command (number layout props arg)
1209   (markup?)
1210   font
1211   ()
1212   "Set font family to @code{number}, which yields the font used for
1213 time signatures and fingerings.  This font only contains numbers and
1214 some punctuation.  It doesn't have any letters.
1215
1216 @lilypond[verbatim,quote]
1217 \\markup \\number { 0 1 2 3 4 5 6 7 8 9 . , + - }
1218 @end lilypond"
1219   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg))
1220
1221 (define-builtin-markup-command (roman layout props arg)
1222   (markup?)
1223   font
1224   ()
1225   "Set font family to @code{roman}."
1226   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
1227
1228 (define-builtin-markup-command (huge layout props arg)
1229   (markup?)
1230   font
1231   ()
1232   "Set font size to +2."
1233   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
1234
1235 (define-builtin-markup-command (large layout props arg)
1236   (markup?)
1237   font
1238   ()
1239   "Set font size to +1."
1240   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
1241
1242 (define-builtin-markup-command (normalsize layout props arg)
1243   (markup?)
1244   font
1245   ()
1246   "Set font size to default."
1247   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
1248
1249 (define-builtin-markup-command (small layout props arg)
1250   (markup?)
1251   font
1252   ()
1253   "Set font size to -1."
1254   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
1255
1256 (define-builtin-markup-command (tiny layout props arg)
1257   (markup?)
1258   font
1259   ()
1260   "Set font size to -2."
1261   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
1262
1263 (define-builtin-markup-command (teeny layout props arg)
1264   (markup?)
1265   font
1266   ()
1267   "Set font size to -3."
1268   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
1269
1270 (define-builtin-markup-command (fontCaps layout props arg)
1271   (markup?)
1272   font
1273   ()
1274   "Set @code{font-shape} to @code{caps}."
1275   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
1276
1277 ;; Poor man's caps
1278 (define-builtin-markup-command (smallCaps layout props text)
1279   (markup?)
1280   font
1281   ()
1282   "Turn @code{text}, which should be a string, to small caps.
1283 @example
1284 \\markup \\smallCaps \"Text between double quotes\"
1285 @end example
1286
1287 Note: @code{\\smallCaps} does not support accented characters."
1288   (define (char-list->markup chars lower)
1289     (let ((final-string (string-upcase (reverse-list->string chars))))
1290       (if lower
1291           (markup #:fontsize -2 final-string)
1292           final-string)))
1293   (define (make-small-caps rest-chars currents current-is-lower prev-result)
1294     (if (null? rest-chars)
1295         (make-concat-markup
1296           (reverse! (cons (char-list->markup currents current-is-lower)
1297                           prev-result)))
1298         (let* ((ch (car rest-chars))
1299                (is-lower (char-lower-case? ch)))
1300           (if (or (and current-is-lower is-lower)
1301                   (and (not current-is-lower) (not is-lower)))
1302               (make-small-caps (cdr rest-chars)
1303                                (cons ch currents)
1304                                is-lower
1305                                prev-result)
1306               (make-small-caps (cdr rest-chars)
1307                                (list ch)
1308                                is-lower
1309                                (if (null? currents)
1310                                    prev-result
1311                                    (cons (char-list->markup
1312                                             currents current-is-lower)
1313                                          prev-result)))))))
1314   (interpret-markup layout props
1315     (if (string? text)
1316         (make-small-caps (string->list text) (list) #f (list))
1317         text)))
1318
1319 (define-builtin-markup-command (caps layout props arg)
1320   (markup?)
1321   font
1322   ()
1323   "Emit @var{arg} as small caps."
1324   (interpret-markup layout props (make-smallCaps-markup arg)))
1325
1326 (define-builtin-markup-command (dynamic layout props arg)
1327   (markup?)
1328   font
1329   ()
1330   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
1331 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
1332 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
1333 done in a different font.  The recommended font for this is bold and italic.
1334 @lilypond[verbatim,quote]
1335 \\markup { \\dynamic sfzp }
1336 @end lilypond"
1337   (interpret-markup
1338    layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg))
1339
1340 (define-builtin-markup-command (text layout props arg)
1341   (markup?)
1342   font
1343   ()
1344   "Use a text font instead of music symbol or music alphabet font."
1345
1346   ;; ugh - latin1
1347   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
1348                     arg))
1349
1350 (define-builtin-markup-command (italic layout props arg)
1351   (markup?)
1352   font
1353   ()
1354   "Use italic @code{font-shape} for @var{arg}.
1355
1356 @lilypond[verbatim,quote]
1357 \\markup \\italic { scherzando e leggiero }
1358 @end lilypond"
1359   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
1360
1361 (define-builtin-markup-command (typewriter layout props arg)
1362   (markup?)
1363   font
1364   ()
1365   "Use @code{font-family} typewriter for @var{arg}."
1366   (interpret-markup
1367    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
1368
1369 (define-builtin-markup-command (upright layout props arg)
1370   (markup?)
1371   font
1372   ()
1373   "Set font shape to @code{upright}.  This is the opposite of @code{italic}."
1374   (interpret-markup
1375    layout (prepend-alist-chain 'font-shape 'upright props) arg))
1376
1377 (define-builtin-markup-command (medium layout props arg)
1378   (markup?)
1379   font
1380   ()
1381   "Switch to medium font series (in contrast to bold)."
1382   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
1383                     arg))
1384
1385 (define-builtin-markup-command (normal-text layout props arg)
1386   (markup?)
1387   font
1388   ()
1389   "Set all font related properties (except the size) to get the default
1390 normal text font, no matter what font was used earlier."
1391   ;; ugh - latin1
1392   (interpret-markup layout
1393                     (cons '((font-family . roman) (font-shape . upright)
1394                             (font-series . medium) (font-encoding . latin1))
1395                           props)
1396                     arg))
1397
1398 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1399 ;; symbols.
1400 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1401
1402 (define-builtin-markup-command (doublesharp layout props)
1403   ()
1404   music
1405   ()
1406   "Draw a double sharp symbol.
1407
1408 @lilypond[verbatim,quote]
1409 \\markup { \\doublesharp }
1410 @end lilypond"
1411   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
1412
1413 (define-builtin-markup-command (sesquisharp layout props)
1414   ()
1415   music
1416   ()
1417   "Draw a 3/2 sharp symbol.
1418
1419 @lilypond[verbatim,quote]
1420 \\markup { \\sesquisharp }
1421 @end lilypond"
1422   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
1423
1424 (define-builtin-markup-command (sharp layout props)
1425   ()
1426   music
1427   ()
1428   "Draw a sharp symbol.
1429
1430 @lilypond[verbatim,quote]
1431 \\markup { \\sharp }
1432 @end lilypond"
1433   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
1434
1435 (define-builtin-markup-command (semisharp layout props)
1436   ()
1437   music
1438   ()
1439   "Draw a semi sharp symbol.
1440
1441 @lilypond[verbatim,quote]
1442 \\markup { \\semisharp }
1443 @end lilypond"
1444   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
1445
1446 (define-builtin-markup-command (natural layout props)
1447   ()
1448   music
1449   ()
1450   "Draw a natural symbol.
1451
1452 @lilypond[verbatim,quote]
1453 \\markup { \\natural }
1454 @end lilypond"
1455   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
1456
1457 (define-builtin-markup-command (semiflat layout props)
1458   ()
1459   music
1460   ()
1461   "Draw a semiflat symbol.
1462
1463 @lilypond[verbatim,quote]
1464 \\markup { \\semiflat }
1465 @end lilypond"
1466   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
1467
1468 (define-builtin-markup-command (flat layout props)
1469   ()
1470   music
1471   ()
1472   "Draw a flat symbol.
1473
1474 @lilypond[verbatim,quote]
1475 \\markup { \\flat }
1476 @end lilypond"
1477   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
1478
1479 (define-builtin-markup-command (sesquiflat layout props)
1480   ()
1481   music
1482   ()
1483   "Draw a 3/2 flat symbol.
1484
1485 @lilypond[verbatim,quote]
1486 \\markup { \\sesquiflat }
1487 @end lilypond"
1488   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
1489
1490 (define-builtin-markup-command (doubleflat layout props)
1491   ()
1492   music
1493   ()
1494   "Draw a double flat symbol.
1495
1496 @lilypond[verbatim,quote]
1497 \\markup { \\doubleflat }
1498 @end lilypond"
1499   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
1500
1501 (define-builtin-markup-command (with-color layout props color arg)
1502   (color? markup?)
1503   other
1504   ()
1505   "
1506 @cindex coloring text
1507
1508 Draw @var{arg} in color specified by @var{color}."
1509   (let ((stil (interpret-markup layout props arg)))
1510     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
1511                      (ly:stencil-extent stil X)
1512                      (ly:stencil-extent stil Y))))
1513 \f
1514 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1515 ;; glyphs
1516 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1517
1518 (define-builtin-markup-command (arrow-head layout props axis direction filled)
1519   (integer? ly:dir? boolean?)
1520   graphic
1521   ()
1522   "Produce an arrow head in specified direction and axis.
1523 Use the filled head if @var{filled} is specified.
1524 @lilypond[verbatim,quote]
1525 \\markup {
1526   \\fontsize #5
1527   \\general-align #Y #DOWN {
1528     \\arrow-head #Y #UP ##t
1529     \\arrow-head #Y #DOWN ##f
1530     \\hspace #2
1531     \\arrow-head #X #RIGHT ##f
1532     \\arrow-head #X #LEFT ##f
1533   }
1534 }
1535 @end lilypond"
1536   (let*
1537       ((name (format "arrowheads.~a.~a~a"
1538                      (if filled
1539                          "close"
1540                          "open")
1541                      axis
1542                      direction)))
1543     (ly:font-get-glyph
1544      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
1545                                      props))
1546      name)))
1547
1548 (define-builtin-markup-command (musicglyph layout props glyph-name)
1549   (string?)
1550   music
1551   ()
1552   "@var{glyph-name} is converted to a musical symbol; for example,
1553 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
1554 the music font.  See @ruser{The Feta font} for a complete listing of
1555 the possible glyphs.
1556
1557 @lilypond[verbatim,quote]
1558 \\markup {
1559   \\musicglyph #\"f\"
1560   \\musicglyph #\"rests.2\"
1561   \\musicglyph #\"clefs.G_change\"
1562 }
1563 @end lilypond"
1564
1565   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
1566                                                  props)))
1567          (glyph (ly:font-get-glyph font glyph-name)))
1568     (if (null? (ly:stencil-expr glyph))
1569         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
1570
1571     glyph))
1572
1573 (define-builtin-markup-command (lookup layout props glyph-name)
1574   (string?)
1575   other
1576   ()
1577   "Lookup a glyph by name."
1578   (ly:font-get-glyph (ly:paper-get-font layout props)
1579                      glyph-name))
1580
1581 (define-builtin-markup-command (char layout props num)
1582   (integer?)
1583   other
1584   ()
1585   "Produce a single character.  For example, @code{\\char #65} produces the
1586 letter @q{A}."
1587   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
1588
1589 (define number->mark-letter-vector (make-vector 25 #\A))
1590
1591 (do ((i 0 (1+ i))
1592      (j 0 (1+ j)))
1593     ((>= i 26))
1594   (if (= i (- (char->integer #\I) (char->integer #\A)))
1595       (set! i (1+ i)))
1596   (vector-set! number->mark-letter-vector j
1597                (integer->char (+ i (char->integer #\A)))))
1598
1599 (define number->mark-alphabet-vector (list->vector
1600   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
1601
1602 (define (number->markletter-string vec n)
1603   "Double letters for big marks."
1604   (let* ((lst (vector-length vec)))
1605
1606     (if (>= n lst)
1607         (string-append (number->markletter-string vec (1- (quotient n lst)))
1608                        (number->markletter-string vec (remainder n lst)))
1609         (make-string 1 (vector-ref vec n)))))
1610
1611 (define-builtin-markup-command (markletter layout props num)
1612   (integer?)
1613   other
1614   ()
1615   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
1616 (skipping letter@tie{}I), and continue with double letters.
1617
1618 @lilypond[verbatim,quote]
1619 \\markup { \\markletter #8 \\hspace #2 \\markletter #26 }
1620 @end lilypond"
1621   (ly:text-interface::interpret-markup layout props
1622     (number->markletter-string number->mark-letter-vector num)))
1623
1624 (define-builtin-markup-command (markalphabet layout props num)
1625   (integer?)
1626   other
1627   ()
1628    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
1629 and continue with double letters.
1630
1631 @lilypond[verbatim,quote]
1632 \\markup { \\markalphabet #8 \\hspace #2 \\markalphabet #26 }
1633 @end lilypond"
1634    (ly:text-interface::interpret-markup layout props
1635      (number->markletter-string number->mark-alphabet-vector num)))
1636
1637 (define-builtin-markup-command (slashed-digit layout props num)
1638   (integer?)
1639   other
1640   ((font-size 0)
1641    (thickness 1.6))
1642   "
1643 @cindex slashed digits
1644
1645 A feta number, with slash.  This is for use in the context of
1646 figured bass notation.
1647 @lilypond[verbatim,quote]
1648 \\markup {
1649   \\slashed-digit #5
1650   \\hspace #2
1651   \\override #'(thickness . 3)
1652   \\slashed-digit #7
1653 }
1654 @end lilypond"
1655   (let* ((mag (magstep font-size))
1656          (thickness (* mag
1657                        (ly:output-def-lookup layout 'line-thickness)
1658                        thickness))
1659          (dy (* mag 0.15))
1660          (number-stencil (interpret-markup layout
1661                                            (prepend-alist-chain 'font-encoding 'fetaNumber props)
1662                                            (number->string num)))
1663          (num-x (interval-widen (ly:stencil-extent number-stencil X)
1664                                 (* mag 0.2)))
1665          (num-y (ly:stencil-extent number-stencil Y))
1666          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
1667          (slash-stencil (if is-sane
1668                             (ly:make-stencil
1669                              `(draw-line ,thickness
1670                                          ,(car num-x) ,(- (interval-center num-y) dy)
1671                                          ,(cdr num-x) ,(+ (interval-center num-y) dy))
1672                              num-x num-y)
1673                             #f)))
1674     (set! slash-stencil
1675           (cond ((not (ly:stencil? slash-stencil)) #f)
1676                 ((= num 5)
1677                  (ly:stencil-translate slash-stencil
1678                                        ;;(cons (* mag -0.05) (* mag 0.42))
1679                                        (cons (* mag -0.00) (* mag -0.07))))
1680                 ((= num 7)
1681                  (ly:stencil-translate slash-stencil
1682                                        ;;(cons (* mag -0.05) (* mag 0.42))
1683                                        (cons (* mag -0.00) (* mag -0.15))))
1684                 (else slash-stencil)))
1685     (if slash-stencil
1686         (set! number-stencil
1687               (ly:stencil-add number-stencil slash-stencil))
1688         (ly:warning "invalid number for slashed digit ~a" num))
1689     number-stencil))
1690 \f
1691 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1692 ;; the note command.
1693 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1694
1695 ;; TODO: better syntax.
1696
1697 (define-builtin-markup-command (note-by-number layout props log dot-count dir)
1698   (number? number? number?)
1699   music
1700   ((font-size 0)
1701    (style '()))
1702   "
1703 @cindex notes within text by log and dot-count
1704
1705 Construct a note symbol, with stem.  By using fractional values for
1706 @var{dir}, you can obtain longer or shorter stems."
1707
1708   (define (get-glyph-name-candidates dir log style)
1709     (map (lambda (dir-name)
1710      (format "noteheads.~a~a~a" dir-name (min log 2)
1711              (if (and (symbol? style)
1712                       (not (equal? 'default style)))
1713                  (symbol->string style)
1714                  "")))
1715          (list (if (= dir UP) "u" "d")
1716                "s")))
1717
1718   (define (get-glyph-name font cands)
1719     (if (null? cands)
1720      ""
1721      (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
1722          (get-glyph-name font (cdr cands))
1723          (car cands))))
1724
1725   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
1726          (size-factor (magstep font-size))
1727          (stem-length (*  size-factor (max 3 (- log 1))))
1728          (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style)))
1729          (head-glyph (ly:font-get-glyph font head-glyph-name))
1730          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
1731          (stem-thickness (* size-factor 0.13))
1732          (stemy (* dir stem-length))
1733          (attach-off (cons (interval-index
1734                             (ly:stencil-extent head-glyph X)
1735                             (* (sign dir) (car attach-indices)))
1736                            (* (sign dir)        ; fixme, this is inconsistent between X & Y.
1737                               (interval-index
1738                                (ly:stencil-extent head-glyph Y)
1739                                (cdr attach-indices)))))
1740          (stem-glyph (and (> log 0)
1741                           (ly:round-filled-box
1742                            (ordered-cons (car attach-off)
1743                                          (+ (car attach-off)  (* (- (sign dir)) stem-thickness)))
1744                            (cons (min stemy (cdr attach-off))
1745                                  (max stemy (cdr attach-off)))
1746                            (/ stem-thickness 3))))
1747
1748          (dot (ly:font-get-glyph font "dots.dot"))
1749          (dotwid (interval-length (ly:stencil-extent dot X)))
1750          (dots (and (> dot-count 0)
1751                     (apply ly:stencil-add
1752                            (map (lambda (x)
1753                                   (ly:stencil-translate-axis
1754                                    dot (* 2 x dotwid) X))
1755                                 (iota dot-count)))))
1756          (flaggl (and (> log 2)
1757                       (ly:stencil-translate
1758                        (ly:font-get-glyph font
1759                                           (string-append "flags."
1760                                                          (if (> dir 0) "u" "d")
1761                                                          (number->string log)))
1762                        (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy)))))
1763
1764     ; If there is a flag on an upstem and the stem is short, move the dots to avoid the flag.
1765     ; 16th notes get a special case because their flags hang lower than any other flags.
1766     (if (and dots (> dir 0) (> log 2) (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
1767         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
1768     (if flaggl
1769         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
1770     (if (ly:stencil? stem-glyph)
1771         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
1772         (set! stem-glyph head-glyph))
1773     (if (ly:stencil? dots)
1774         (set! stem-glyph
1775               (ly:stencil-add
1776                (ly:stencil-translate-axis
1777                 dots
1778                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
1779                 X)
1780                stem-glyph)))
1781     stem-glyph))
1782
1783 (define-public log2
1784   (let ((divisor (log 2)))
1785     (lambda (z) (inexact->exact (/ (log z) divisor)))))
1786
1787 (define (parse-simple-duration duration-string)
1788   "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list."
1789   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
1790     (if (and match (string=? duration-string (match:substring match 0)))
1791         (let ((len  (match:substring match 1))
1792               (dots (match:substring match 2)))
1793           (list (cond ((string=? len "breve") -1)
1794                       ((string=? len "longa") -2)
1795                       ((string=? len "maxima") -3)
1796                       (else (log2 (string->number len))))
1797                 (if dots (string-length dots) 0)))
1798         (ly:error (_ "not a valid duration string: ~a") duration-string))))
1799
1800 (define-builtin-markup-command (note layout props duration dir)
1801   (string? number?)
1802   music
1803   (note-by-number-markup)
1804   "
1805 @cindex notes within text by string
1806
1807 This produces a note with a stem pointing in @var{dir} direction, with
1808 the @var{duration} for the note head type and augmentation dots.  For
1809 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
1810 a shortened down stem."
1811   (let ((parsed (parse-simple-duration duration)))
1812     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
1813 \f
1814 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1815 ;; translating.
1816 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1817
1818 (define-builtin-markup-command (lower layout props amount arg)
1819   (number? markup?)
1820   align
1821   ()
1822   "
1823 @cindex lowering text
1824
1825 Lower @var{arg} by the distance @var{amount}.
1826 A negative @var{amount} indicates raising; see also @code{\\raise}."
1827   (ly:stencil-translate-axis (interpret-markup layout props arg)
1828                              (- amount) Y))
1829
1830 (define-builtin-markup-command (translate-scaled layout props offset arg)
1831   (number-pair? markup?)
1832   other
1833   ((font-size 0))
1834   "
1835 @cindex translating text
1836 @cindex scaling text
1837
1838 Translate @var{arg} by @var{offset}, scaling the offset by the
1839 @code{font-size}."
1840   (let* ((factor (magstep font-size))
1841          (scaled (cons (* factor (car offset))
1842                        (* factor (cdr offset)))))
1843     (ly:stencil-translate (interpret-markup layout props arg)
1844                           scaled)))
1845
1846 (define-builtin-markup-command (raise layout props amount arg)
1847   (number? markup?)
1848   align
1849   ()
1850   "
1851 @cindex raising text
1852
1853 Raise @var{arg} by the distance @var{amount}.
1854 A negative @var{amount} indicates lowering, see also @code{\\lower}.
1855
1856 The argument to @code{\\raise} is the vertical displacement amount,
1857 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
1858 raise objects in relation to their surrounding markups.
1859
1860 If the text object itself is positioned above or below the staff, then
1861 @code{\\raise} cannot be used to move it, since the mechanism that
1862 positions it next to the staff cancels any shift made with
1863 @code{\\raise}.  For vertical positioning, use the @code{padding}
1864 and/or @code{extra-offset} properties.
1865
1866 @lilypond[verbatim,quote]
1867 \\markup { C \\small \\raise #1.0 \\bold 9/7+ }
1868 @end lilypond"
1869   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
1870
1871 (define-builtin-markup-command (fraction layout props arg1 arg2)
1872   (markup? markup?)
1873   other
1874   ((font-size 0))
1875   "
1876 @cindex creating text fractions
1877
1878 Make a fraction of two markups.
1879 @lilypond[verbatim,quote]
1880 \\markup { π ≈ \\fraction 355 113 }
1881 @end lilypond"
1882   (let* ((m1 (interpret-markup layout props arg1))
1883          (m2 (interpret-markup layout props arg2))
1884          (factor (magstep font-size))
1885          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
1886          (padding (* factor 0.2))
1887          (baseline (* factor 0.6))
1888          (offset (* factor 0.75)))
1889     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
1890     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
1891     (let* ((x1 (ly:stencil-extent m1 X))
1892            (x2 (ly:stencil-extent m2 X))
1893            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
1894            ;; should stack mols separately, to maintain LINE on baseline
1895            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
1896       (set! stack
1897             (ly:stencil-aligned-to stack Y CENTER))
1898       (set! stack
1899             (ly:stencil-aligned-to stack X LEFT))
1900       ;; should have EX dimension
1901       ;; empirical anyway
1902       (ly:stencil-translate-axis stack offset Y))))
1903
1904 (define-builtin-markup-command (normal-size-super layout props arg)
1905   (markup?)
1906   font
1907   ((baseline-skip))
1908   "
1909 @cindex setting superscript in standard font size
1910
1911 Set @var{arg} in superscript with a normal font size."
1912   (ly:stencil-translate-axis
1913    (interpret-markup layout props arg)
1914    (* 0.5 baseline-skip) Y))
1915
1916 (define-builtin-markup-command (super layout props arg)
1917   (markup?)
1918   font
1919   ((font-size 0)
1920    (baseline-skip))
1921   "
1922 @cindex superscript text
1923
1924 Raising and lowering texts can be done with @code{\\super} and
1925 @code{\\sub}:
1926
1927 @lilypond[verbatim,quote]
1928 \\markup { E = \\concat { mc \\super 2 } }
1929 @end lilypond"
1930   (ly:stencil-translate-axis
1931    (interpret-markup
1932     layout
1933     (cons `((font-size . ,(- font-size 3))) props)
1934     arg)
1935    (* 0.5 baseline-skip)
1936    Y))
1937
1938 (define-builtin-markup-command (translate layout props offset arg)
1939   (number-pair? markup?)
1940   align
1941   ()
1942   "
1943 @cindex translating text
1944
1945 This translates an object.  Its first argument is a cons of numbers.
1946
1947 @example
1948 A \\translate #(cons 2 -3) @{ B C @} D
1949 @end example
1950
1951 This moves @q{B C} 2@tie{}spaces to the right, and 3 down, relative to its
1952 surroundings.  This command cannot be used to move isolated scripts
1953 vertically, for the same reason that @code{\\raise} cannot be used for
1954 that."
1955   (ly:stencil-translate (interpret-markup  layout props arg)
1956                         offset))
1957
1958 (define-builtin-markup-command (sub layout props arg)
1959   (markup?)
1960   font
1961   ((font-size 0)
1962    (baseline-skip))
1963   "
1964 @cindex subscript text
1965
1966 Set @var{arg} in subscript."
1967   (ly:stencil-translate-axis
1968    (interpret-markup
1969     layout
1970     (cons `((font-size . ,(- font-size 3))) props)
1971     arg)
1972    (* -0.5 baseline-skip)
1973    Y))
1974
1975 (define-builtin-markup-command (normal-size-sub layout props arg)
1976   (markup?)
1977   font
1978   ((baseline-skip))
1979   "
1980 @cindex setting subscript in standard font size
1981
1982 Set @var{arg} in subscript, in a normal font size."
1983   (ly:stencil-translate-axis
1984    (interpret-markup layout props arg)
1985    (* -0.5 baseline-skip)
1986    Y))
1987 \f
1988 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1989 ;; brackets.
1990 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1991
1992 (define-builtin-markup-command (hbracket layout props arg)
1993   (markup?)
1994   graphic
1995   ()
1996   "
1997 @cindex placing horizontal brackets around text
1998
1999 Draw horizontal brackets around @var{arg}."
2000   (let ((th 0.1) ;; todo: take from GROB.
2001         (m (interpret-markup layout props arg)))
2002     (bracketify-stencil m X th (* 2.5 th) th)))
2003
2004 (define-builtin-markup-command (bracket layout props arg)
2005   (markup?)
2006   graphic
2007   ()
2008   "
2009 @cindex placing vertical brackets around text
2010
2011 Draw vertical brackets around @var{arg}."
2012   (let ((th 0.1) ;; todo: take from GROB.
2013         (m (interpret-markup layout props arg)))
2014     (bracketify-stencil m Y th (* 2.5 th) th)))
2015 \f
2016 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2017 ;; Delayed markup evaluation
2018 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2019
2020 (define-builtin-markup-command (page-ref layout props label gauge default)
2021   (symbol? markup? markup?)
2022   other
2023   ()
2024   "
2025 @cindex referencing page numbers in text
2026
2027 Reference to a page number. @var{label} is the label set on the referenced
2028 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
2029 the maximum width of the page number, and @var{default} the value to display
2030 when @var{label} is not found."
2031   (let* ((gauge-stencil (interpret-markup layout props gauge))
2032          (x-ext (ly:stencil-extent gauge-stencil X))
2033          (y-ext (ly:stencil-extent gauge-stencil Y)))
2034     (ly:make-stencil
2035      `(delay-stencil-evaluation
2036        ,(delay (ly:stencil-expr
2037                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
2038                        (label-page (and (list? table) (assoc label table)))
2039                        (page-number (and label-page (cdr label-page)))
2040                        (page-markup (if page-number (format "~a" page-number) default))
2041                        (page-stencil (interpret-markup layout props page-markup))
2042                        (gap (- (interval-length x-ext)
2043                                (interval-length (ly:stencil-extent page-stencil X)))))
2044                   (interpret-markup layout props
2045                                     (markup #:concat (#:hspace gap page-markup)))))))
2046      x-ext
2047      y-ext)))
2048 \f
2049 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2050 ;; Markup list commands
2051 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2052
2053 (define-public (space-lines baseline-skip lines)
2054   (map (lambda (line)
2055          (stack-lines DOWN 0.0 (/ baseline-skip 2.0)
2056                       (list point-stencil
2057                             line
2058                             point-stencil)))
2059        lines))
2060
2061 (define-builtin-markup-list-command (justified-lines layout props args)
2062   (markup-list?)
2063   ((baseline-skip)
2064    wordwrap-internal-markup-list)
2065   "
2066 @cindex justifying lines of text
2067
2068 Like @code{\\justify}, but return a list of lines instead of a single markup.
2069 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
2070 @var{X}@tie{}is the number of staff spaces."
2071   (space-lines baseline-skip
2072                (interpret-markup-list layout props
2073                                       (make-wordwrap-internal-markup-list #t args))))
2074
2075 (define-builtin-markup-list-command (wordwrap-lines layout props args)
2076   (markup-list?)
2077   ((baseline-skip)
2078    wordwrap-internal-markup-list)
2079   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
2080 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
2081 where @var{X} is the number of staff spaces."
2082   (space-lines baseline-skip
2083                (interpret-markup-list layout props
2084                                       (make-wordwrap-internal-markup-list #f args))))
2085
2086 (define-builtin-markup-list-command (column-lines layout props args)
2087   (markup-list?)
2088   ((baseline-skip))
2089   "Like @code{\\column}, but return a list of lines instead of a single markup.
2090 @code{baseline-skip} determines the space between each markup in @var{args}."
2091   (space-lines (chain-assoc-get 'baseline-skip props)
2092                (interpret-markup-list layout props args)))
2093
2094 (define-builtin-markup-list-command (override-lines layout props new-prop args)
2095   (pair? markup-list?)
2096   ()
2097   "Like @code{\\override}, for markup lists."
2098   (interpret-markup-list layout (cons (list new-prop) props) args))