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
1566                                   (cons '((font-encoding . fetaMusic)
1567                                           (font-name . #f))
1568
1569                                                  props)))
1570          (glyph (ly:font-get-glyph font glyph-name)))
1571     (if (null? (ly:stencil-expr glyph))
1572         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
1573
1574     glyph))
1575
1576 (define-builtin-markup-command (lookup layout props glyph-name)
1577   (string?)
1578   other
1579   ()
1580   "Lookup a glyph by name."
1581   (ly:font-get-glyph (ly:paper-get-font layout props)
1582                      glyph-name))
1583
1584 (define-builtin-markup-command (char layout props num)
1585   (integer?)
1586   other
1587   ()
1588   "Produce a single character.  For example, @code{\\char #65} produces the
1589 letter @q{A}."
1590   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
1591
1592 (define number->mark-letter-vector (make-vector 25 #\A))
1593
1594 (do ((i 0 (1+ i))
1595      (j 0 (1+ j)))
1596     ((>= i 26))
1597   (if (= i (- (char->integer #\I) (char->integer #\A)))
1598       (set! i (1+ i)))
1599   (vector-set! number->mark-letter-vector j
1600                (integer->char (+ i (char->integer #\A)))))
1601
1602 (define number->mark-alphabet-vector (list->vector
1603   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
1604
1605 (define (number->markletter-string vec n)
1606   "Double letters for big marks."
1607   (let* ((lst (vector-length vec)))
1608
1609     (if (>= n lst)
1610         (string-append (number->markletter-string vec (1- (quotient n lst)))
1611                        (number->markletter-string vec (remainder n lst)))
1612         (make-string 1 (vector-ref vec n)))))
1613
1614 (define-builtin-markup-command (markletter layout props num)
1615   (integer?)
1616   other
1617   ()
1618   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
1619 (skipping letter@tie{}I), and continue with double letters.
1620
1621 @lilypond[verbatim,quote]
1622 \\markup { \\markletter #8 \\hspace #2 \\markletter #26 }
1623 @end lilypond"
1624   (ly:text-interface::interpret-markup layout props
1625     (number->markletter-string number->mark-letter-vector num)))
1626
1627 (define-builtin-markup-command (markalphabet layout props num)
1628   (integer?)
1629   other
1630   ()
1631    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
1632 and continue with double letters.
1633
1634 @lilypond[verbatim,quote]
1635 \\markup { \\markalphabet #8 \\hspace #2 \\markalphabet #26 }
1636 @end lilypond"
1637    (ly:text-interface::interpret-markup layout props
1638      (number->markletter-string number->mark-alphabet-vector num)))
1639
1640 (define-builtin-markup-command (slashed-digit layout props num)
1641   (integer?)
1642   other
1643   ((font-size 0)
1644    (thickness 1.6))
1645   "
1646 @cindex slashed digits
1647
1648 A feta number, with slash.  This is for use in the context of
1649 figured bass notation.
1650 @lilypond[verbatim,quote]
1651 \\markup {
1652   \\slashed-digit #5
1653   \\hspace #2
1654   \\override #'(thickness . 3)
1655   \\slashed-digit #7
1656 }
1657 @end lilypond"
1658   (let* ((mag (magstep font-size))
1659          (thickness (* mag
1660                        (ly:output-def-lookup layout 'line-thickness)
1661                        thickness))
1662          (dy (* mag 0.15))
1663          (number-stencil (interpret-markup layout
1664                                            (prepend-alist-chain 'font-encoding 'fetaNumber props)
1665                                            (number->string num)))
1666          (num-x (interval-widen (ly:stencil-extent number-stencil X)
1667                                 (* mag 0.2)))
1668          (num-y (ly:stencil-extent number-stencil Y))
1669          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
1670          (slash-stencil (if is-sane
1671                             (ly:make-stencil
1672                              `(draw-line ,thickness
1673                                          ,(car num-x) ,(- (interval-center num-y) dy)
1674                                          ,(cdr num-x) ,(+ (interval-center num-y) dy))
1675                              num-x num-y)
1676                             #f)))
1677     (set! slash-stencil
1678           (cond ((not (ly:stencil? slash-stencil)) #f)
1679                 ((= num 5)
1680                  (ly:stencil-translate slash-stencil
1681                                        ;;(cons (* mag -0.05) (* mag 0.42))
1682                                        (cons (* mag -0.00) (* mag -0.07))))
1683                 ((= num 7)
1684                  (ly:stencil-translate slash-stencil
1685                                        ;;(cons (* mag -0.05) (* mag 0.42))
1686                                        (cons (* mag -0.00) (* mag -0.15))))
1687                 (else slash-stencil)))
1688     (if slash-stencil
1689         (set! number-stencil
1690               (ly:stencil-add number-stencil slash-stencil))
1691         (ly:warning "invalid number for slashed digit ~a" num))
1692     number-stencil))
1693 \f
1694 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1695 ;; the note command.
1696 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1697
1698 ;; TODO: better syntax.
1699
1700 (define-builtin-markup-command (note-by-number layout props log dot-count dir)
1701   (number? number? number?)
1702   music
1703   ((font-size 0)
1704    (style '()))
1705   "
1706 @cindex notes within text by log and dot-count
1707
1708 Construct a note symbol, with stem.  By using fractional values for
1709 @var{dir}, you can obtain longer or shorter stems."
1710
1711   (define (get-glyph-name-candidates dir log style)
1712     (map (lambda (dir-name)
1713      (format "noteheads.~a~a~a" dir-name (min log 2)
1714              (if (and (symbol? style)
1715                       (not (equal? 'default style)))
1716                  (symbol->string style)
1717                  "")))
1718          (list (if (= dir UP) "u" "d")
1719                "s")))
1720
1721   (define (get-glyph-name font cands)
1722     (if (null? cands)
1723      ""
1724      (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
1725          (get-glyph-name font (cdr cands))
1726          (car cands))))
1727
1728   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
1729          (size-factor (magstep font-size))
1730          (stem-length (*  size-factor (max 3 (- log 1))))
1731          (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style)))
1732          (head-glyph (ly:font-get-glyph font head-glyph-name))
1733          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
1734          (stem-thickness (* size-factor 0.13))
1735          (stemy (* dir stem-length))
1736          (attach-off (cons (interval-index
1737                             (ly:stencil-extent head-glyph X)
1738                             (* (sign dir) (car attach-indices)))
1739                            (* (sign dir)        ; fixme, this is inconsistent between X & Y.
1740                               (interval-index
1741                                (ly:stencil-extent head-glyph Y)
1742                                (cdr attach-indices)))))
1743          (stem-glyph (and (> log 0)
1744                           (ly:round-filled-box
1745                            (ordered-cons (car attach-off)
1746                                          (+ (car attach-off)  (* (- (sign dir)) stem-thickness)))
1747                            (cons (min stemy (cdr attach-off))
1748                                  (max stemy (cdr attach-off)))
1749                            (/ stem-thickness 3))))
1750
1751          (dot (ly:font-get-glyph font "dots.dot"))
1752          (dotwid (interval-length (ly:stencil-extent dot X)))
1753          (dots (and (> dot-count 0)
1754                     (apply ly:stencil-add
1755                            (map (lambda (x)
1756                                   (ly:stencil-translate-axis
1757                                    dot (* 2 x dotwid) X))
1758                                 (iota dot-count)))))
1759          (flaggl (and (> log 2)
1760                       (ly:stencil-translate
1761                        (ly:font-get-glyph font
1762                                           (string-append "flags."
1763                                                          (if (> dir 0) "u" "d")
1764                                                          (number->string log)))
1765                        (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy)))))
1766
1767     ; If there is a flag on an upstem and the stem is short, move the dots to avoid the flag.
1768     ; 16th notes get a special case because their flags hang lower than any other flags.
1769     (if (and dots (> dir 0) (> log 2) (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
1770         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
1771     (if flaggl
1772         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
1773     (if (ly:stencil? stem-glyph)
1774         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
1775         (set! stem-glyph head-glyph))
1776     (if (ly:stencil? dots)
1777         (set! stem-glyph
1778               (ly:stencil-add
1779                (ly:stencil-translate-axis
1780                 dots
1781                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
1782                 X)
1783                stem-glyph)))
1784     stem-glyph))
1785
1786 (define-public log2
1787   (let ((divisor (log 2)))
1788     (lambda (z) (inexact->exact (/ (log z) divisor)))))
1789
1790 (define (parse-simple-duration duration-string)
1791   "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list."
1792   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
1793     (if (and match (string=? duration-string (match:substring match 0)))
1794         (let ((len  (match:substring match 1))
1795               (dots (match:substring match 2)))
1796           (list (cond ((string=? len "breve") -1)
1797                       ((string=? len "longa") -2)
1798                       ((string=? len "maxima") -3)
1799                       (else (log2 (string->number len))))
1800                 (if dots (string-length dots) 0)))
1801         (ly:error (_ "not a valid duration string: ~a") duration-string))))
1802
1803 (define-builtin-markup-command (note layout props duration dir)
1804   (string? number?)
1805   music
1806   (note-by-number-markup)
1807   "
1808 @cindex notes within text by string
1809
1810 This produces a note with a stem pointing in @var{dir} direction, with
1811 the @var{duration} for the note head type and augmentation dots.  For
1812 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
1813 a shortened down stem."
1814   (let ((parsed (parse-simple-duration duration)))
1815     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
1816 \f
1817 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1818 ;; translating.
1819 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1820
1821 (define-builtin-markup-command (lower layout props amount arg)
1822   (number? markup?)
1823   align
1824   ()
1825   "
1826 @cindex lowering text
1827
1828 Lower @var{arg} by the distance @var{amount}.
1829 A negative @var{amount} indicates raising; see also @code{\\raise}."
1830   (ly:stencil-translate-axis (interpret-markup layout props arg)
1831                              (- amount) Y))
1832
1833 (define-builtin-markup-command (translate-scaled layout props offset arg)
1834   (number-pair? markup?)
1835   other
1836   ((font-size 0))
1837   "
1838 @cindex translating text
1839 @cindex scaling text
1840
1841 Translate @var{arg} by @var{offset}, scaling the offset by the
1842 @code{font-size}."
1843   (let* ((factor (magstep font-size))
1844          (scaled (cons (* factor (car offset))
1845                        (* factor (cdr offset)))))
1846     (ly:stencil-translate (interpret-markup layout props arg)
1847                           scaled)))
1848
1849 (define-builtin-markup-command (raise layout props amount arg)
1850   (number? markup?)
1851   align
1852   ()
1853   "
1854 @cindex raising text
1855
1856 Raise @var{arg} by the distance @var{amount}.
1857 A negative @var{amount} indicates lowering, see also @code{\\lower}.
1858
1859 The argument to @code{\\raise} is the vertical displacement amount,
1860 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
1861 raise objects in relation to their surrounding markups.
1862
1863 If the text object itself is positioned above or below the staff, then
1864 @code{\\raise} cannot be used to move it, since the mechanism that
1865 positions it next to the staff cancels any shift made with
1866 @code{\\raise}.  For vertical positioning, use the @code{padding}
1867 and/or @code{extra-offset} properties.
1868
1869 @lilypond[verbatim,quote]
1870 \\markup { C \\small \\raise #1.0 \\bold 9/7+ }
1871 @end lilypond"
1872   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
1873
1874 (define-builtin-markup-command (fraction layout props arg1 arg2)
1875   (markup? markup?)
1876   other
1877   ((font-size 0))
1878   "
1879 @cindex creating text fractions
1880
1881 Make a fraction of two markups.
1882 @lilypond[verbatim,quote]
1883 \\markup { π ≈ \\fraction 355 113 }
1884 @end lilypond"
1885   (let* ((m1 (interpret-markup layout props arg1))
1886          (m2 (interpret-markup layout props arg2))
1887          (factor (magstep font-size))
1888          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
1889          (padding (* factor 0.2))
1890          (baseline (* factor 0.6))
1891          (offset (* factor 0.75)))
1892     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
1893     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
1894     (let* ((x1 (ly:stencil-extent m1 X))
1895            (x2 (ly:stencil-extent m2 X))
1896            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
1897            ;; should stack mols separately, to maintain LINE on baseline
1898            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
1899       (set! stack
1900             (ly:stencil-aligned-to stack Y CENTER))
1901       (set! stack
1902             (ly:stencil-aligned-to stack X LEFT))
1903       ;; should have EX dimension
1904       ;; empirical anyway
1905       (ly:stencil-translate-axis stack offset Y))))
1906
1907 (define-builtin-markup-command (normal-size-super layout props arg)
1908   (markup?)
1909   font
1910   ((baseline-skip))
1911   "
1912 @cindex setting superscript in standard font size
1913
1914 Set @var{arg} in superscript with a normal font size."
1915   (ly:stencil-translate-axis
1916    (interpret-markup layout props arg)
1917    (* 0.5 baseline-skip) Y))
1918
1919 (define-builtin-markup-command (super layout props arg)
1920   (markup?)
1921   font
1922   ((font-size 0)
1923    (baseline-skip))
1924   "
1925 @cindex superscript text
1926
1927 Raising and lowering texts can be done with @code{\\super} and
1928 @code{\\sub}:
1929
1930 @lilypond[verbatim,quote]
1931 \\markup { E = \\concat { mc \\super 2 } }
1932 @end lilypond"
1933   (ly:stencil-translate-axis
1934    (interpret-markup
1935     layout
1936     (cons `((font-size . ,(- font-size 3))) props)
1937     arg)
1938    (* 0.5 baseline-skip)
1939    Y))
1940
1941 (define-builtin-markup-command (translate layout props offset arg)
1942   (number-pair? markup?)
1943   align
1944   ()
1945   "
1946 @cindex translating text
1947
1948 This translates an object.  Its first argument is a cons of numbers.
1949
1950 @example
1951 A \\translate #(cons 2 -3) @{ B C @} D
1952 @end example
1953
1954 This moves @q{B C} 2@tie{}spaces to the right, and 3 down, relative to its
1955 surroundings.  This command cannot be used to move isolated scripts
1956 vertically, for the same reason that @code{\\raise} cannot be used for
1957 that."
1958   (ly:stencil-translate (interpret-markup  layout props arg)
1959                         offset))
1960
1961 (define-builtin-markup-command (sub layout props arg)
1962   (markup?)
1963   font
1964   ((font-size 0)
1965    (baseline-skip))
1966   "
1967 @cindex subscript text
1968
1969 Set @var{arg} in subscript."
1970   (ly:stencil-translate-axis
1971    (interpret-markup
1972     layout
1973     (cons `((font-size . ,(- font-size 3))) props)
1974     arg)
1975    (* -0.5 baseline-skip)
1976    Y))
1977
1978 (define-builtin-markup-command (normal-size-sub layout props arg)
1979   (markup?)
1980   font
1981   ((baseline-skip))
1982   "
1983 @cindex setting subscript in standard font size
1984
1985 Set @var{arg} in subscript, in a normal font size."
1986   (ly:stencil-translate-axis
1987    (interpret-markup layout props arg)
1988    (* -0.5 baseline-skip)
1989    Y))
1990 \f
1991 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1992 ;; brackets.
1993 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1994
1995 (define-builtin-markup-command (hbracket layout props arg)
1996   (markup?)
1997   graphic
1998   ()
1999   "
2000 @cindex placing horizontal brackets around text
2001
2002 Draw horizontal brackets around @var{arg}."
2003   (let ((th 0.1) ;; todo: take from GROB.
2004         (m (interpret-markup layout props arg)))
2005     (bracketify-stencil m X th (* 2.5 th) th)))
2006
2007 (define-builtin-markup-command (bracket layout props arg)
2008   (markup?)
2009   graphic
2010   ()
2011   "
2012 @cindex placing vertical brackets around text
2013
2014 Draw vertical brackets around @var{arg}."
2015   (let ((th 0.1) ;; todo: take from GROB.
2016         (m (interpret-markup layout props arg)))
2017     (bracketify-stencil m Y th (* 2.5 th) th)))
2018 \f
2019 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2020 ;; Delayed markup evaluation
2021 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2022
2023 (define-builtin-markup-command (page-ref layout props label gauge default)
2024   (symbol? markup? markup?)
2025   other
2026   ()
2027   "
2028 @cindex referencing page numbers in text
2029
2030 Reference to a page number. @var{label} is the label set on the referenced
2031 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
2032 the maximum width of the page number, and @var{default} the value to display
2033 when @var{label} is not found."
2034   (let* ((gauge-stencil (interpret-markup layout props gauge))
2035          (x-ext (ly:stencil-extent gauge-stencil X))
2036          (y-ext (ly:stencil-extent gauge-stencil Y)))
2037     (ly:make-stencil
2038      `(delay-stencil-evaluation
2039        ,(delay (ly:stencil-expr
2040                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
2041                        (label-page (and (list? table) (assoc label table)))
2042                        (page-number (and label-page (cdr label-page)))
2043                        (page-markup (if page-number (format "~a" page-number) default))
2044                        (page-stencil (interpret-markup layout props page-markup))
2045                        (gap (- (interval-length x-ext)
2046                                (interval-length (ly:stencil-extent page-stencil X)))))
2047                   (interpret-markup layout props
2048                                     (markup #:concat (#:hspace gap page-markup)))))))
2049      x-ext
2050      y-ext)))
2051 \f
2052 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2053 ;; Markup list commands
2054 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2055
2056 (define-public (space-lines baseline-skip lines)
2057   (map (lambda (line)
2058          (stack-lines DOWN 0.0 (/ baseline-skip 2.0)
2059                       (list point-stencil
2060                             line
2061                             point-stencil)))
2062        lines))
2063
2064 (define-builtin-markup-list-command (justified-lines layout props args)
2065   (markup-list?)
2066   ((baseline-skip)
2067    wordwrap-internal-markup-list)
2068   "
2069 @cindex justifying lines of text
2070
2071 Like @code{\\justify}, but return a list of lines instead of a single markup.
2072 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
2073 @var{X}@tie{}is the number of staff spaces."
2074   (space-lines baseline-skip
2075                (interpret-markup-list layout props
2076                                       (make-wordwrap-internal-markup-list #t args))))
2077
2078 (define-builtin-markup-list-command (wordwrap-lines layout props args)
2079   (markup-list?)
2080   ((baseline-skip)
2081    wordwrap-internal-markup-list)
2082   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
2083 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
2084 where @var{X} is the number of staff spaces."
2085   (space-lines baseline-skip
2086                (interpret-markup-list layout props
2087                                       (make-wordwrap-internal-markup-list #f args))))
2088
2089 (define-builtin-markup-list-command (column-lines layout props args)
2090   (markup-list?)
2091   ((baseline-skip))
2092   "Like @code{\\column}, but return a list of lines instead of a single markup.
2093 @code{baseline-skip} determines the space between each markup in @var{args}."
2094   (space-lines (chain-assoc-get 'baseline-skip props)
2095                (interpret-markup-list layout props args)))
2096
2097 (define-builtin-markup-list-command (override-lines layout props new-prop args)
2098   (pair? markup-list?)
2099   ()
2100   "Like @code{\\override}, for markup lists."
2101   (interpret-markup-list layout (cons (list new-prop) props) args))