scm/define-markup-commands.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2000--2012  Han-Wen Nienhuys <hanwen@xs4all.nl>
   4 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
   5 ;;;;
   6 ;;;; LilyPond is free software: you can redistribute it and/or modify
   7 ;;;; it under the terms of the GNU General Public License as published by
   8 ;;;; the Free Software Foundation, either version 3 of the License, or
   9 ;;;; (at your option) any later version.
  10 ;;;;
  11 ;;;; LilyPond is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;;; GNU General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU General Public License
  17 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 ;;;
  20 ;;; Markup commands and markup-list commands definitions.
  21 ;;;
  22 ;;; Markup commands which are part of LilyPond, are defined
  23 ;;; in the (lily) module, which is the current module in this file,
  24 ;;; using the `define-markup-command' macro.
  25 ;;;
  26 ;;; Usage:
  27 ;;;
  28 ;;; (define-markup-command (command-name layout props args...)
  29 ;;;   args-signature
  30 ;;;   [ #:category category ]
  31 ;;;   [ #:properties property-bindings ]
  32 ;;;   documentation-string
  33 ;;;   ..body..)
  34 ;;;
  35 ;;; with:
  36 ;;;   command-name
  37 ;;;     the name of the markup command
  38 ;;;
  39 ;;;   layout and props
  40 ;;;     arguments that are automatically passed to the command when it
  41 ;;;     is interpreted.
  42 ;;;     `layout' is an output def, which properties can be accessed
  43 ;;;     using `ly:output-def-lookup'.
  44 ;;;     `props' is a list of property settings which can be accessed
  45 ;;;     using `chain-assoc-get' (more on that below)
  46 ;;;
  47 ;;;   args...
  48 ;;;     the command arguments.
  49 ;;;     There is no limitation on the order of command arguments.
  50 ;;;     However, markup functions taking a markup as their last
  51 ;;;     argument are somewhat special as you can apply them to a
  52 ;;;     markup list, and the result is a markup list where the
  53 ;;;     markup function (with the specified leading arguments) has
  54 ;;;     been applied to every element of the original markup list.
  55 ;;;
  56 ;;;     Since replicating the leading arguments for applying a
  57 ;;;     markup function to a markup list is cheap mostly for
  58 ;;;     Scheme arguments, you avoid performance pitfalls by just
  59 ;;;     using Scheme arguments for the leading arguments of markup
  60 ;;;     functions that take a markup as their last argument.
  61 ;;;
  62 ;;;   args-signature
  63 ;;;     the arguments signature, i.e., a list of type predicates which
  64 ;;;     are used to type check the arguments, and also to define the general
  65 ;;;     argument types (markup, markup-list, scheme) that the command is
  66 ;;;     expecting.
  67 ;;;     For instance, if a command expects a number, then a markup, the
  68 ;;;     signature would be: (number? markup?)
  69 ;;;
  70 ;;;   category
  71 ;;;     for documentation purpose, builtin markup commands are grouped by
  72 ;;;     category.  This can be any symbol.  When documentation is generated,
  73 ;;;     the symbol is converted to a capitalized string, where hyphens are
  74 ;;;     replaced by spaces.
  75 ;;;
  76 ;;;   property-bindings
  77 ;;;     this is used both for documentation generation, and to ease
  78 ;;;     programming the command itself.  It is list of
  79 ;;;        (property-name default-value)
  80 ;;;     or (property-name)
  81 ;;;     elements.  Each property is looked-up in the `props' argument, and
  82 ;;;     the symbol naming the property is bound to its value.
  83 ;;;     When the property is not found in `props', then the symbol is bound
  84 ;;;     to the given default value.  When no default value is given, #f is
  85 ;;;     used instead.
  86 ;;;     Thus, using the following property bindings:
  87 ;;;       ((thickness 0.1)
  88 ;;;        (font-size 0))
  89 ;;;     is equivalent to writing:
  90 ;;;       (let ((thickness (chain-assoc-get 'thickness props 0.1))
  91 ;;;             (font-size (chain-assoc-get 'font-size props 0)))
  92 ;;;         ..body..)
  93 ;;;     When a command `B' internally calls an other command `A', it may
  94 ;;;     desirable to see in `B' documentation all the properties and
  95 ;;;     default values used by `A'.  In that case, add `A-markup' to the
  96 ;;;     property-bindings of B.  (This is used when generating
  97 ;;;     documentation, but won't create bindings.)
  98 ;;;
  99 ;;;   documentation-string
 100 ;;;     the command documentation string (used to generate manuals)
 101 ;;;
 102 ;;;   body
 103 ;;;     the command body.  The function is supposed to return a stencil.
 104 ;;;
 105 ;;; Each markup command definition shall have a documentation string
 106 ;;; with description, syntax and example.
 107
 108 (use-modules (ice-9 regex))
 109
 110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 111 ;; utility functions
 112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 113
 114 (define-public empty-stencil (ly:make-stencil '()
 115                                               empty-interval empty-interval))
 116 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
 117
 118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 119 ;; geometric shapes
 120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 121
 122 (define-markup-command (draw-line layout props dest)
 123   (number-pair?)
 124   #:category graphic
 125   #:properties ((thickness 1))
 126   "
 127 @cindex drawing lines within text
 128
 129 A simple line.
 130 @lilypond[verbatim,quote]
 131 \\markup {
 132   \\draw-line #'(4 . 4)
 133   \\override #'(thickness . 5)
 134   \\draw-line #'(-3 . 0)
 135 }
 136 @end lilypond"
 137   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 138                thickness))
 139         (x (car dest))
 140         (y (cdr dest)))
 141     (make-line-stencil th 0 0 x y)))
 142
 143 (define-markup-command (draw-dashed-line layout props dest)
 144   (number-pair?)
 145   #:category graphic
 146   #:properties ((thickness 1)
 147                 (on 1)
 148                 (off 1)
 149                 (phase 0)
 150                 (full-length #t))
 151   "
 152 @cindex drawing dashed lines within text
 153
 154 A dashed line.
 155
 156 If @code{full-length} is set to #t (default) the dashed-line extends to the
 157 whole length given by @var{dest}, without white space at beginning or end.
 158 @code{off} will then be altered to fit.
 159 To insist on the given (or default) values of @code{on}, @code{off} use
 160 @code{\\override #'(full-length . #f)}
 161 Manual settings for @code{on},@code{off} and @code{phase} are possible.
 162 @lilypond[verbatim,quote]
 163 \\markup {
 164   \\draw-dashed-line #'(5.1 . 2.3)
 165   \\override #'(on . 0.3)
 166   \\override #'(off . 0.5)
 167   \\draw-dashed-line #'(5.1 . 2.3)
 168 }
 169 @end lilypond"
 170   (let* ((line-thickness (ly:output-def-lookup layout 'line-thickness))
 171          ;; Calculate the thickness to be used.
 172          (th (* line-thickness thickness))
 173          (half-thick (/ th 2))
 174          ;; Get the extensions in x- and y-direction.
 175          (x (car dest))
 176          (y (cdr dest))
 177          ;; Calculate the length of the dashed line.
 178          (line-length (sqrt (+ (expt x 2) (expt y 2)))))
 179
 180     (if (and full-length (not (= (+ on off) 0)))
 181         (begin
 182           ;; Add double-thickness to avoid overlapping.
 183           (set! off (+ (* 2 th) off))
 184           (let* (;; Make a guess how often the off/on-pair should be printed
 185                  ;; after the initial `on´.
 186                  ;; Assume a minimum of 1 to avoid division by zero.
 187                  (guess (max 1 (round (/ (- line-length on) (+ off on)))))
 188                  ;; Not sure about the value or why corr is necessary at all,
 189                  ;; but it seems to be necessary.
 190                  (corr (if (= on 0)
 191                            (/ line-thickness 10)
 192                            0))
 193                  ;; Calculate a new value for off to fit the
 194                  ;; line-length.
 195                  (new-off (/ (- line-length corr (* (1+ guess) on)) guess))
 196                  )
 197               (cond
 198
 199               ;; Settings for (= on 0). Resulting in a dotted line.
 200
 201                     ;; If line-length isn't shorter than `th´, change the given
 202                     ;; value for `off´ to fit the line-length.
 203                     ((and (= on 0) (< th line-length))
 204                       (set! off new-off))
 205
 206                     ;; If the line-length is shorter than `th´, it makes no
 207                     ;; sense to adjust `off´. The rounded edges of the lines
 208                     ;; would prevent any nice output.
 209                     ;; Do nothing.
 210                     ;; This will result in a single dot for very short lines.
 211                     ((and (= on 0) (>= th line-length))
 212                       #f)
 213
 214               ;; Settings for (not (= on 0)). Resulting in a dashed line.
 215
 216                     ;; If line-length isn't shorter than one go of on-off-on,
 217                     ;; change the given value for `off´ to fit the line-length.
 218                     ((< (+ (* 2 on) off) line-length)
 219                       (set! off new-off))
 220                     ;; If the line-length is too short, but greater than
 221                     ;; (* 4 th) set on/off to (/ line-length 3)
 222                     ((< (* 4 th) line-length)
 223                       (set! on (/ line-length 3))
 224                       (set! off (/ line-length 3)))
 225                     ;; If the line-length is shorter than (* 4 th), it makes
 226                     ;; no sense trying to adjust on/off. The rounded edges of
 227                     ;; the lines would prevent any nice output.
 228                     ;; Simply set `on´ to line-length.
 229                     (else
 230                       (set! on line-length))))))
 231
 232     ;; If `on´ or `off´ is negative, or the sum of `on' and `off' equals zero a
 233     ;; ghostscript-error occurs while calling
 234     ;; (ly:make-stencil (list 'dashed-line th on off x y phase) x-ext y-ext)
 235     ;; Better be paranoid.
 236     (if (or (= (+ on off) 0)
 237             (negative? on)
 238             (negative? off))
 239         (begin
 240           (ly:warning "Can't print a line - setting on/off to default")
 241           (set! on 1)
 242           (set! off 1)))
 243
 244     ;; To give the lines produced by \draw-line and \draw-dashed-line the same
 245     ;; length, half-thick has to be added to the stencil-extensions.
 246     (ly:make-stencil
 247       (list 'dashed-line th on off x y phase)
 248         (interval-widen (ordered-cons 0 x) half-thick)
 249         (interval-widen (ordered-cons 0 y) half-thick))))
 250
 251 (define-markup-command (draw-dotted-line layout props dest)
 252   (number-pair?)
 253   #:category graphic
 254   #:properties ((thickness 1)
 255                 (off 1)
 256                 (phase 0))
 257   "
 258 @cindex drawing dotted lines within text
 259
 260 A dotted line.
 261
 262 The dotted-line always extends to the whole length given by @var{dest}, without
 263 white space at beginning or end.
 264 Manual settings for @code{off} are possible to get larger or smaller space
 265 between the dots.
 266 The given (or default) value of @code{off} will be altered to fit the
 267 line-length.
 268 @lilypond[verbatim,quote]
 269 \\markup {
 270   \\draw-dotted-line #'(5.1 . 2.3)
 271   \\override #'(thickness . 2)
 272   \\override #'(off . 0.2)
 273   \\draw-dotted-line #'(5.1 . 2.3)
 274 }
 275 @end lilypond"
 276
 277   (let ((new-props (prepend-alist-chain 'on 0
 278                      (prepend-alist-chain 'full-length #t props))))
 279
 280   (interpret-markup layout
 281                     new-props
 282                     (markup #:draw-dashed-line dest))))
 283
 284 (define-markup-command (draw-hline layout props)
 285   ()
 286   #:category graphic
 287   #:properties ((draw-line-markup)
 288                 (line-width)
 289                 (span-factor 1))
 290   "
 291 @cindex drawing a line across a page
 292
 293 Draws a line across a page, where the property @code{span-factor}
 294 controls what fraction of the page is taken up.
 295 @lilypond[verbatim,quote]
 296 \\markup {
 297   \\column {
 298     \\draw-hline
 299     \\override #'(span-factor . 1/3)
 300     \\draw-hline
 301   }
 302 }
 303 @end lilypond"
 304   (interpret-markup layout
 305                     props
 306                     (markup #:draw-line (cons (* line-width
 307                                                   span-factor)
 308                                                0))))
 309
 310 (define-markup-command (draw-circle layout props radius thickness filled)
 311   (number? number? boolean?)
 312   #:category graphic
 313   "
 314 @cindex drawing circles within text
 315
 316 A circle of radius @var{radius} and thickness @var{thickness},
 317 optionally filled.
 318
 319 @lilypond[verbatim,quote]
 320 \\markup {
 321   \\draw-circle #2 #0.5 ##f
 322   \\hspace #2
 323   \\draw-circle #2 #0 ##t
 324 }
 325 @end lilypond"
 326   (make-circle-stencil radius thickness filled))
 327
 328 (define-markup-command (triangle layout props filled)
 329   (boolean?)
 330   #:category graphic
 331   #:properties ((thickness 0.1)
 332                 (font-size 0)
 333                 (baseline-skip 2))
 334   "
 335 @cindex drawing triangles within text
 336
 337 A triangle, either filled or empty.
 338
 339 @lilypond[verbatim,quote]
 340 \\markup {
 341   \\triangle ##t
 342   \\hspace #2
 343   \\triangle ##f
 344 }
 345 @end lilypond"
 346   (let ((ex (* (magstep font-size) 0.8 baseline-skip)))
 347     (ly:make-stencil
 348      `(polygon '(0.0 0.0
 349                      ,ex 0.0
 350                      ,(* 0.5 ex)
 351                      ,(* 0.86 ex))
 352            ,thickness
 353            ,filled)
 354      (cons 0 ex)
 355      (cons 0 (* .86 ex)))))
 356
 357 (define-markup-command (circle layout props arg)
 358   (markup?)
 359   #:category graphic
 360   #:properties ((thickness 1)
 361                 (font-size 0)
 362                 (circle-padding 0.2))
 363   "
 364 @cindex circling text
 365
 366 Draw a circle around @var{arg}.  Use @code{thickness},
 367 @code{circle-padding} and @code{font-size} properties to determine line
 368 thickness and padding around the markup.
 369
 370 @lilypond[verbatim,quote]
 371 \\markup {
 372   \\circle {
 373     Hi
 374   }
 375 }
 376 @end lilypond"
 377   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 378                thickness))
 379          (pad (* (magstep font-size) circle-padding))
 380          (m (interpret-markup layout props arg)))
 381     (circle-stencil m th pad)))
 382
 383 (define-markup-command (with-url layout props url arg)
 384   (string? markup?)
 385   #:category graphic
 386   "
 387 @cindex inserting URL links into text
 388
 389 Add a link to URL @var{url} around @var{arg}.  This only works in
 390 the PDF backend.
 391
 392 @lilypond[verbatim,quote]
 393 \\markup {
 394   \\with-url #\"http://lilypond.org/\" {
 395     LilyPond ... \\italic {
 396       music notation for everyone
 397     }
 398   }
 399 }
 400 @end lilypond"
 401   (let* ((stil (interpret-markup layout props arg))
 402          (xextent (ly:stencil-extent stil X))
 403          (yextent (ly:stencil-extent stil Y))
 404          (old-expr (ly:stencil-expr stil))
 405          (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
 406
 407     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
 408
 409 (define-markup-command (page-link layout props page-number arg)
 410   (number? markup?)
 411   #:category other
 412   "
 413 @cindex referencing page numbers in text
 414
 415 Add a link to the page @var{page-number} around @var{arg}.  This only works
 416 in the PDF backend.
 417
 418 @lilypond[verbatim,quote]
 419 \\markup {
 420   \\page-link #2  { \\italic { This links to page 2... } }
 421 }
 422 @end lilypond"
 423   (let* ((stil (interpret-markup layout props arg))
 424          (xextent (ly:stencil-extent stil X))
 425          (yextent (ly:stencil-extent stil Y))
 426          (old-expr (ly:stencil-expr stil))
 427          (link-expr (list 'page-link page-number `(quote ,xextent) `(quote ,yextent))))
 428
 429     (ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil)))
 430
 431 (define-markup-command (with-link layout props label arg)
 432   (symbol? markup?)
 433   #:category other
 434   "
 435 @cindex referencing page labels in text
 436
 437 Add a link to the page holding label @var{label} around @var{arg}.  This
 438 only works in the PDF backend.
 439
 440 @lilypond[verbatim,quote]
 441 \\markup {
 442   \\with-link #'label {
 443     \\italic { This links to the page containing the label... }
 444   }
 445 }
 446 @end lilypond"
 447   (let* ((arg-stencil (interpret-markup layout props arg))
 448          (x-ext (ly:stencil-extent arg-stencil X))
 449          (y-ext (ly:stencil-extent arg-stencil Y)))
 450     (ly:make-stencil
 451      `(delay-stencil-evaluation
 452        ,(delay (ly:stencil-expr
 453                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
 454                        (page-number (if (list? table)
 455                                         (assoc-get label table)
 456                                         #f))
 457                        (link-expr (list 'page-link page-number
 458                                         `(quote ,x-ext) `(quote ,y-ext))))
 459                   (ly:stencil-add (ly:make-stencil link-expr x-ext y-ext)
 460 arg-stencil)))))
 461      x-ext
 462      y-ext)))
 463
 464
 465 (define-markup-command (beam layout props width slope thickness)
 466   (number? number? number?)
 467   #:category graphic
 468   "
 469 @cindex drawing beams within text
 470
 471 Create a beam with the specified parameters.
 472 @lilypond[verbatim,quote]
 473 \\markup {
 474   \\beam #5 #1 #2
 475 }
 476 @end lilypond"
 477   (let* ((y (* slope width))
 478          (yext (cons (min 0 y) (max 0 y)))
 479          (half (/ thickness 2)))
 480
 481     (ly:make-stencil
 482      `(polygon ',(list
 483                   0 (/ thickness -2)
 484                     width (+ (* width slope)  (/ thickness -2))
 485                     width (+ (* width slope)  (/ thickness 2))
 486                     0 (/ thickness 2))
 487                ,(ly:output-def-lookup layout 'blot-diameter)
 488                #t)
 489      (cons 0 width)
 490      (cons (+ (- half) (car yext))
 491            (+ half (cdr yext))))))
 492
 493 (define-markup-command (underline layout props arg)
 494   (markup?)
 495   #:category font
 496   #:properties ((thickness 1) (offset 2))
 497   "
 498 @cindex underlining text
 499
 500 Underline @var{arg}.  Looks at @code{thickness} to determine line
 501 thickness, and @code{offset} to determine line y-offset.
 502
 503 @lilypond[verbatim,quote]
 504 \\markup \\fill-line {
 505   \\underline \"underlined\"
 506   \\override #'(offset . 5)
 507   \\override #'(thickness . 1)
 508   \\underline \"underlined\"
 509   \\override #'(offset . 1)
 510   \\override #'(thickness . 5)
 511   \\underline \"underlined\"
 512 }
 513 @end lilypond"
 514   (let* ((thick (ly:output-def-lookup layout 'line-thickness))
 515          (underline-thick (* thickness thick))
 516          (markup (interpret-markup layout props arg))
 517          (x1 (car (ly:stencil-extent markup X)))
 518          (x2 (cdr (ly:stencil-extent markup X)))
 519          (y (* thick (- offset)))
 520          (line (make-line-stencil underline-thick x1 y x2 y)))
 521     (ly:stencil-add markup line)))
 522
 523 (define-markup-command (box layout props arg)
 524   (markup?)
 525   #:category font
 526   #:properties ((thickness 1)
 527                 (font-size 0)
 528                 (box-padding 0.2))
 529   "
 530 @cindex enclosing text within a box
 531
 532 Draw a box round @var{arg}.  Looks at @code{thickness},
 533 @code{box-padding} and @code{font-size} properties to determine line
 534 thickness and padding around the markup.
 535
 536 @lilypond[verbatim,quote]
 537 \\markup {
 538   \\override #'(box-padding . 0.5)
 539   \\box
 540   \\line { V. S. }
 541 }
 542 @end lilypond"
 543   (let* ((th (* (ly:output-def-lookup layout 'line-thickness)
 544                 thickness))
 545          (pad (* (magstep font-size) box-padding))
 546          (m (interpret-markup layout props arg)))
 547     (box-stencil m th pad)))
 548
 549 (define-markup-command (filled-box layout props xext yext blot)
 550   (number-pair? number-pair? number?)
 551   #:category graphic
 552   "
 553 @cindex drawing solid boxes within text
 554 @cindex drawing boxes with rounded corners
 555
 556 Draw a box with rounded corners of dimensions @var{xext} and
 557 @var{yext}.  For example,
 558 @verbatim
 559 \\filled-box #'(-.3 . 1.8) #'(-.3 . 1.8) #0
 560 @end verbatim
 561 creates a box extending horizontally from -0.3 to 1.8 and
 562 vertically from -0.3 up to 1.8, with corners formed from a
 563 circle of diameter@tie{}0 (i.e., sharp corners).
 564
 565 @lilypond[verbatim,quote]
 566 \\markup {
 567   \\filled-box #'(0 . 4) #'(0 . 4) #0
 568   \\filled-box #'(0 . 2) #'(-4 . 2) #0.4
 569   \\filled-box #'(1 . 8) #'(0 . 7) #0.2
 570   \\with-color #white
 571   \\filled-box #'(-4.5 . -2.5) #'(3.5 . 5.5) #0.7
 572 }
 573 @end lilypond"
 574   (ly:round-filled-box
 575    xext yext blot))
 576
 577 (define-markup-command (rounded-box layout props arg)
 578   (markup?)
 579   #:category graphic
 580   #:properties ((thickness 1)
 581                 (corner-radius 1)
 582                 (font-size 0)
 583                 (box-padding 0.5))
 584   "@cindex enclosing text in a box with rounded corners
 585    @cindex drawing boxes with rounded corners around text
 586 Draw a box with rounded corners around @var{arg}.  Looks at @code{thickness},
 587 @code{box-padding} and @code{font-size} properties to determine line
 588 thickness and padding around the markup; the @code{corner-radius} property
 589 makes it possible to define another shape for the corners (default is 1).
 590
 591 @lilypond[quote,verbatim,relative=2]
 592 c4^\\markup {
 593   \\rounded-box {
 594     Overtura
 595   }
 596 }
 597 c,8. c16 c4 r
 598 @end lilypond"
 599   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 600                thickness))
 601         (pad (* (magstep font-size) box-padding))
 602         (m (interpret-markup layout props arg)))
 603     (ly:stencil-add (rounded-box-stencil m th pad corner-radius)
 604                     m)))
 605
 606 (define-markup-command (rotate layout props ang arg)
 607   (number? markup?)
 608   #:category align
 609   "
 610 @cindex rotating text
 611
 612 Rotate object with @var{ang} degrees around its center.
 613
 614 @lilypond[verbatim,quote]
 615 \\markup {
 616   default
 617   \\hspace #2
 618   \\rotate #45
 619   \\line {
 620     rotated 45°
 621   }
 622 }
 623 @end lilypond"
 624   (let* ((stil (interpret-markup layout props arg)))
 625     (ly:stencil-rotate stil ang 0 0)))
 626
 627 (define-markup-command (whiteout layout props arg)
 628   (markup?)
 629   #:category other
 630   "
 631 @cindex adding a white background to text
 632
 633 Provide a white background for @var{arg}.
 634
 635 @lilypond[verbatim,quote]
 636 \\markup {
 637   \\combine
 638     \\filled-box #'(-1 . 10) #'(-3 . 4) #1
 639     \\whiteout whiteout
 640 }
 641 @end lilypond"
 642   (stencil-whiteout (interpret-markup layout props arg)))
 643
 644 (define-markup-command (pad-markup layout props amount arg)
 645   (number? markup?)
 646   #:category align
 647   "
 648 @cindex padding text
 649 @cindex putting space around text
 650
 651 Add space around a markup object.
 652
 653 @lilypond[verbatim,quote]
 654 \\markup {
 655   \\box {
 656     default
 657   }
 658   \\hspace #2
 659   \\box {
 660     \\pad-markup #1 {
 661       padded
 662     }
 663   }
 664 }
 665 @end lilypond"
 666   (let*
 667       ((stil (interpret-markup layout props arg))
 668        (xext (ly:stencil-extent stil X))
 669        (yext (ly:stencil-extent stil Y)))
 670
 671     (ly:make-stencil
 672      (ly:stencil-expr stil)
 673      (interval-widen xext amount)
 674      (interval-widen yext amount))))
 675
 676 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 677 ;; space
 678 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 679
 680 (define-markup-command (strut layout props)
 681   ()
 682   #:category other
 683   "
 684 @cindex creating vertical spaces in text
 685
 686 Create a box of the same height as the space in the current font."
 687   (let ((m (ly:text-interface::interpret-markup layout props " ")))
 688     (ly:make-stencil (ly:stencil-expr m)
 689                      '(0 . 0)
 690                      (ly:stencil-extent m X)
 691                      )))
 692
 693 (define-markup-command (hspace layout props amount)
 694   (number?)
 695   #:category align
 696   "
 697 @cindex creating horizontal spaces in text
 698
 699 Create an invisible object taking up horizontal space @var{amount}.
 700
 701 @lilypond[verbatim,quote]
 702 \\markup {
 703   one
 704   \\hspace #2
 705   two
 706   \\hspace #8
 707   three
 708 }
 709 @end lilypond"
 710   (ly:make-stencil "" (cons 0 amount) empty-interval))
 711
 712 (define-markup-command (vspace layout props amount)
 713  (number?)
 714  #:category align
 715  "
 716 @cindex creating vertical spaces in text
 717
 718 Create an invisible object taking up vertical space
 719 of @var{amount} multiplied by 3.
 720
 721 @lilypond[verbatim,quote]
 722 \\markup {
 723     \\center-column {
 724     one
 725     \\vspace #2
 726     two
 727     \\vspace #5
 728     three
 729   }
 730 }
 731 @end lilypond"
 732   (let ((amount (* amount 3.0)))
 733     (ly:make-stencil "" empty-interval (cons 0 amount))))
 734
 735
 736 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 737 ;; importing graphics.
 738 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 739
 740 (define-markup-command (stencil layout props stil)
 741   (ly:stencil?)
 742   #:category other
 743   "
 744 @cindex importing stencils into text
 745
 746 Use a stencil as markup.
 747
 748 @lilypond[verbatim,quote]
 749 \\markup {
 750   \\stencil #(make-circle-stencil 2 0 #t)
 751 }
 752 @end lilypond"
 753   stil)
 754
 755 (define bbox-regexp
 756   (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
 757
 758 (define (get-postscript-bbox string)
 759   "Extract the bbox from STRING, or return #f if not present."
 760   (let*
 761       ((match (regexp-exec bbox-regexp string)))
 762
 763     (if match
 764         (map (lambda (x)
 765                (string->number (match:substring match x)))
 766              (cdr (iota 5)))
 767
 768         #f)))
 769
 770 (define-markup-command (epsfile layout props axis size file-name)
 771   (number? number? string?)
 772   #:category graphic
 773   "
 774 @cindex inlining an Encapsulated PostScript image
 775
 776 Inline an EPS image.  The image is scaled along @var{axis} to
 777 @var{size}.
 778
 779 @lilypond[verbatim,quote]
 780 \\markup {
 781   \\general-align #Y #DOWN {
 782     \\epsfile #X #20 #\"context-example.eps\"
 783     \\epsfile #Y #20 #\"context-example.eps\"
 784   }
 785 }
 786 @end lilypond"
 787   (if (ly:get-option 'safe)
 788       (interpret-markup layout props "not allowed in safe")
 789       (eps-file->stencil axis size file-name)
 790       ))
 791
 792 (define-markup-command (postscript layout props str)
 793   (string?)
 794   #:category graphic
 795   "
 796 @cindex inserting PostScript directly into text
 797 This inserts @var{str} directly into the output as a PostScript
 798 command string.
 799
 800 @lilypond[verbatim,quote]
 801 ringsps = #\"
 802   0.15 setlinewidth
 803   0.9 0.6 moveto
 804   0.4 0.6 0.5 0 361 arc
 805   stroke
 806   1.0 0.6 0.5 0 361 arc
 807   stroke
 808   \"
 809
 810 rings = \\markup {
 811   \\with-dimensions #'(-0.2 . 1.6) #'(0 . 1.2)
 812   \\postscript #ringsps
 813 }
 814
 815 \\relative c'' {
 816   c2^\\rings
 817   a2_\\rings
 818 }
 819 @end lilypond"
 820   ;; FIXME
 821   (ly:make-stencil
 822    (list 'embedded-ps
 823          (format #f "
 824 gsave currentpoint translate
 825 0.1 setlinewidth
 826  ~a
 827 grestore
 828 "
 829                  str))
 830    '(0 . 0) '(0 . 0)))
 831
 832 (define-markup-command (path layout props thickness commands) (number? list?)
 833   #:category graphic
 834   #:properties ((line-cap-style 'round)
 835                 (line-join-style 'round)
 836                 (filled #f))
 837   "
 838 @cindex paths, drawing
 839 @cindex drawing paths
 840 Draws a path with line thickness @var{thickness} according to the
 841 directions given in @var{commands}.  @var{commands} is a list of
 842 lists where the @code{car} of each sublist is a drawing command and
 843 the @code{cdr} comprises the associated arguments for each command.
 844
 845 Line-cap styles and line-join styles may be customized by
 846 overriding the @code{line-cap-style} and @code{line-join-style}
 847 properties, respectively.  Available line-cap styles are
 848 @code{'butt}, @code{'round}, and @code{'square}.  Available
 849 line-join styles are @code{'miter}, @code{'round}, and
 850 @code{'bevel}.
 851
 852 The property @code{filled} specifies whether or not the path is
 853 filled with color.
 854
 855 There are seven commands available to use in the list
 856 @code{commands}: @code{moveto}, @code{rmoveto}, @code{lineto},
 857 @code{rlineto}, @code{curveto}, @code{rcurveto}, and
 858 @code{closepath}.  Note that the commands that begin with @emph{r}
 859 are the relative variants of the other three commands.
 860
 861 The commands @code{moveto}, @code{rmoveto}, @code{lineto}, and
 862 @code{rlineto} take 2 arguments; they are the X and Y coordinates
 863 for the destination point.
 864
 865 The commands @code{curveto} and @code{rcurveto} create cubic
 866 Bézier curves, and take 6 arguments; the first two are the X and Y
 867 coordinates for the first control point, the second two are the X
 868 and Y coordinates for the second control point, and the last two
 869 are the X and Y coordinates for the destination point.
 870
 871 The @code{closepath} command takes zero arguments and closes the
 872 current subpath in the active path.
 873
 874 Note that a sequence of commands @emph{must} begin with a
 875 @code{moveto} or @code{rmoveto} to work with the SVG output.
 876
 877 @lilypond[verbatim,quote]
 878 samplePath =
 879   #'((moveto 0 0)
 880      (lineto -1 1)
 881      (lineto 1 1)
 882      (lineto 1 -1)
 883      (curveto -5 -5 -5 5 -1 0)
 884      (closepath))
 885
 886 \\markup {
 887   \\path #0.25 #samplePath
 888 }
 889 @end lilypond"
 890   (let* ((half-thickness (/ thickness 2))
 891          (current-point '(0 . 0))
 892          (set-point (lambda (lst) (set! current-point lst)))
 893          (relative? (lambda (x)
 894                       (string-prefix? "r" (symbol->string (car x)))))
 895          ;; For calculating extents, we want to modify the command
 896          ;; list so that all coordinates are absolute.
 897          (new-commands (map (lambda (x)
 898                               (cond
 899                                 ;; for rmoveto, rlineto
 900                                 ((and (relative? x) (= 3 (length x)))
 901                                  (let ((cp (cons
 902                                              (+ (car current-point)
 903                                                 (second x))
 904                                              (+ (cdr current-point)
 905                                                 (third x)))))
 906                                    (set-point cp)
 907                                    (list (car cp)
 908                                          (cdr cp))))
 909                                 ;; for rcurveto
 910                                 ((and (relative? x) (= 7 (length x)))
 911                                  (let* ((old-cp current-point)
 912                                         (cp (cons
 913                                               (+ (car old-cp)
 914                                                  (sixth x))
 915                                               (+ (cdr old-cp)
 916                                                  (seventh x)))))
 917                                    (set-point cp)
 918                                    (list (+ (car old-cp) (second x))
 919                                          (+ (cdr old-cp) (third x))
 920                                          (+ (car old-cp) (fourth x))
 921                                          (+ (cdr old-cp) (fifth x))
 922                                          (car cp)
 923                                          (cdr cp))))
 924                                 ;; for moveto, lineto
 925                                 ((= 3 (length x))
 926                                  (set-point (cons (second x)
 927                                                   (third x)))
 928                                  (drop x 1))
 929                                 ;; for curveto
 930                                 ((= 7 (length x))
 931                                  (set-point (cons (sixth x)
 932                                                   (seventh x)))
 933                                  (drop x 1))
 934                                 ;; keep closepath for filtering;
 935                                 ;; see `without-closepath'.
 936                                 (else x)))
 937                             commands))
 938          ;; path-min-max does not accept 0-arg lists,
 939          ;; and since closepath does not affect extents, filter
 940          ;; out those commands here.
 941          (without-closepath (filter (lambda (x)
 942                                       (not (equal? 'closepath (car x))))
 943                                     new-commands))
 944          (extents (path-min-max
 945                     ;; set the origin to the first moveto
 946                     (list (list-ref (car without-closepath) 0)
 947                           (list-ref (car without-closepath) 1))
 948                     without-closepath))
 949          (X-extent (cons (list-ref extents 0) (list-ref extents 1)))
 950          (Y-extent (cons (list-ref extents 2) (list-ref extents 3)))
 951          (command-list (fold-right append '() commands)))
 952
 953     ;; account for line thickness
 954     (set! X-extent (interval-widen X-extent half-thickness))
 955     (set! Y-extent (interval-widen Y-extent half-thickness))
 956
 957     (ly:make-stencil
 958       `(path ,thickness `(,@',command-list)
 959              ',line-cap-style ',line-join-style ,filled)
 960       X-extent
 961       Y-extent)))
 962
 963 (define-markup-list-command (score-lines layout props score)
 964   (ly:score?)
 965   "
 966 This is the same as the @code{\\score} markup but delivers its
 967 systems as a list of lines.  This is not usually called directly by
 968 the user.  Instead, it is called when the parser encounters
 969 @code{\\score} in a context where only markup lists are allowed.  When
 970 used as the argument of a toplevel @code{\\markuplist}, the result can
 971 be split across pages."
 972   (let ((output (ly:score-embedded-format score layout)))
 973
 974     (if (ly:music-output? output)
 975         (map
 976          (lambda (paper-system)
 977            ;; shift such that the refpoint of the bottom staff of
 978            ;; the first system is the baseline of the score
 979            (ly:stencil-translate-axis
 980             (paper-system-stencil paper-system)
 981             (- (car (paper-system-staff-extents paper-system)))
 982             Y))
 983          (vector->list (ly:paper-score-paper-systems output)))
 984         (begin
 985           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
 986           '()))))
 987
 988 (define-markup-command (score layout props score)
 989   (ly:score?)
 990   #:category music
 991   #:properties ((baseline-skip))
 992   "
 993 @cindex inserting music into text
 994
 995 Inline an image of music.  The reference point (usually the middle
 996 staff line) of the lowest staff in the top system is placed on the
 997 baseline.
 998
 999 @lilypond[verbatim,quote]
1000 \\markup {
1001   \\score {
1002     \\new PianoStaff <<
1003       \\new Staff \\relative c' {
1004         \\key f \\major
1005         \\time 3/4
1006         \\mark \\markup { Allegro }
1007         f2\\p( a4)
1008         c2( a4)
1009         bes2( g'4)
1010         f8( e) e4 r
1011       }
1012       \\new Staff \\relative c {
1013         \\clef bass
1014         \\key f \\major
1015         \\time 3/4
1016         f8( a c a c a
1017         f c' es c es c)
1018         f,( bes d bes d bes)
1019         f( g bes g bes g)
1020       }
1021     >>
1022     \\layout {
1023       indent = 0.0\\cm
1024       \\context {
1025         \\Score
1026         \\override RehearsalMark
1027           #'break-align-symbols = #'(time-signature key-signature)
1028         \\override RehearsalMark
1029           #'self-alignment-X = #LEFT
1030       }
1031       \\context {
1032         \\Staff
1033         \\override TimeSignature
1034           #'break-align-anchor-alignment = #LEFT
1035       }
1036     }
1037   }
1038 }
1039 @end lilypond"
1040   (stack-stencils Y DOWN baseline-skip
1041                   (score-lines-markup-list layout props score)))
1042
1043 (define-markup-command (null layout props)
1044   ()
1045   #:category other
1046   "
1047 @cindex creating empty text objects
1048
1049 An empty markup with extents of a single point.
1050
1051 @lilypond[verbatim,quote]
1052 \\markup {
1053   \\null
1054 }
1055 @end lilypond"
1056   point-stencil)
1057
1058 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1059 ;; basic formatting.
1060 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1061
1062 (define-markup-command (simple layout props str)
1063   (string?)
1064   #:category font
1065   "
1066 @cindex simple text strings
1067
1068 A simple text string; @code{\\markup @{ foo @}} is equivalent with
1069 @code{\\markup @{ \\simple #\"foo\" @}}.
1070
1071 Note: for creating standard text markup or defining new markup commands,
1072 the use of @code{\\simple} is unnecessary.
1073
1074 @lilypond[verbatim,quote]
1075 \\markup {
1076   \\simple #\"simple\"
1077   \\simple #\"text\"
1078   \\simple #\"strings\"
1079 }
1080 @end lilypond"
1081   (interpret-markup layout props str))
1082
1083 (define-markup-command (tied-lyric layout props str)
1084   (string?)
1085   #:category music
1086   #:properties ((word-space))
1087   "
1088 @cindex simple text strings with tie characters
1089
1090 Like simple-markup, but use tie characters for @q{~} tilde symbols.
1091
1092 @lilypond[verbatim,quote]
1093 \\markup \\column {
1094   \\tied-lyric #\"Siam navi~all'onde~algenti Lasciate~in abbandono\"
1095   \\tied-lyric #\"Impetuosi venti I nostri~affetti sono\"
1096   \\tied-lyric #\"Ogni diletto~e scoglio Tutta la vita~e~un mar.\"
1097 }
1098 @end lilypond"
1099   (define (replace-ties tie str)
1100     (if (string-contains str "~")
1101         (let*
1102           ((half-space (/ word-space 2))
1103            (parts (string-split str #\~))
1104            (tie-str (markup #:hspace half-space
1105                             #:musicglyph tie
1106                             #:hspace half-space))
1107            (joined  (list-join parts tie-str)))
1108           (make-concat-markup joined))
1109         str))
1110
1111   (define short-tie-regexp (make-regexp "~[^.]~"))
1112   (define (match-short str) (regexp-exec short-tie-regexp str))
1113
1114   (define (replace-short str mkp)
1115     (let ((match (match-short str)))
1116       (if (not match)
1117           (make-concat-markup (list
1118             mkp
1119             (replace-ties "ties.lyric.default" str)))
1120           (let ((new-str (match:suffix match))
1121                 (new-mkp (make-concat-markup (list
1122                           mkp
1123                           (replace-ties "ties.lyric.default"
1124                                         (match:prefix match))
1125                           (replace-ties "ties.lyric.short"
1126                                         (match:substring match))))))
1127               (replace-short new-str new-mkp)))))
1128
1129   (interpret-markup layout
1130                     props
1131                     (replace-short str (markup))))
1132
1133 (define-public empty-markup
1134   (make-simple-markup ""))
1135
1136 ;; helper for justifying lines.
1137 (define (get-fill-space word-count line-width word-space text-widths)
1138   "Calculate the necessary paddings between each two adjacent texts.
1139   The lengths of all texts are stored in @var{text-widths}.
1140   The normal formula for the padding between texts a and b is:
1141   padding = line-width/(word-count - 1) - (length(a) + length(b))/2
1142   The first and last padding have to be calculated specially using the
1143   whole length of the first or last text.
1144   All paddings are checked to be at least word-space, to ensure that
1145   no texts collide.
1146   Return a list of paddings."
1147   (cond
1148    ((null? text-widths) '())
1149
1150    ;; special case first padding
1151    ((= (length text-widths) word-count)
1152     (cons
1153      (- (- (/ line-width (1- word-count)) (car text-widths))
1154         (/ (car (cdr text-widths)) 2))
1155      (get-fill-space word-count line-width word-space (cdr text-widths))))
1156    ;; special case last padding
1157    ((= (length text-widths) 2)
1158     (list (- (/ line-width (1- word-count))
1159              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
1160    (else
1161     (let ((default-padding
1162             (- (/ line-width (1- word-count))
1163                (/ (+ (car text-widths) (car (cdr text-widths))) 2))))
1164       (cons
1165        (if (> word-space default-padding)
1166            word-space
1167            default-padding)
1168        (get-fill-space word-count line-width word-space (cdr text-widths)))))))
1169
1170 (define-markup-command (fill-line layout props args)
1171   (markup-list?)
1172   #:category align
1173   #:properties ((text-direction RIGHT)
1174                 (word-space 0.6)
1175                 (line-width #f))
1176   "Put @var{markups} in a horizontal line of width @var{line-width}.
1177 The markups are spaced or flushed to fill the entire line.
1178 If there are no arguments, return an empty stencil.
1179
1180 @lilypond[verbatim,quote]
1181 \\markup {
1182   \\column {
1183     \\fill-line {
1184       Words evenly spaced across the page
1185     }
1186     \\null
1187     \\fill-line {
1188       \\line { Text markups }
1189       \\line {
1190         \\italic { evenly spaced }
1191       }
1192       \\line { across the page }
1193     }
1194   }
1195 }
1196 @end lilypond"
1197   (let* ((orig-stencils (interpret-markup-list layout props args))
1198          (stencils
1199           (map (lambda (stc)
1200                  (if (ly:stencil-empty? stc)
1201                      point-stencil
1202                      stc)) orig-stencils))
1203          (text-widths
1204           (map (lambda (stc)
1205                  (if (ly:stencil-empty? stc)
1206                      0.0
1207                      (interval-length (ly:stencil-extent stc X))))
1208                stencils))
1209          (text-width (apply + text-widths))
1210          (word-count (length stencils))
1211          (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
1212          (fill-space
1213           (cond
1214            ((= word-count 1)
1215             (list
1216              (/ (- line-width text-width) 2)
1217              (/ (- line-width text-width) 2)))
1218            ((= word-count 2)
1219             (list
1220              (- line-width text-width)))
1221            (else
1222             (get-fill-space word-count line-width word-space text-widths))))
1223
1224          (line-contents (if (= word-count 1)
1225                             (list
1226                              point-stencil
1227                              (car stencils)
1228                              point-stencil)
1229                             stencils)))
1230
1231     (if (null? (remove ly:stencil-empty? orig-stencils))
1232         empty-stencil
1233         (begin
1234           (if (= text-direction LEFT)
1235               (set! line-contents (reverse line-contents)))
1236           (set! line-contents
1237                 (stack-stencils-padding-list
1238                  X RIGHT fill-space line-contents))
1239           (if (> word-count 1)
1240               ;; shift s.t. stencils align on the left edge, even if
1241               ;; first stencil had negative X-extent (e.g. center-column)
1242               ;; (if word-count = 1, X-extents are already normalized in
1243               ;; the definition of line-contents)
1244               (set! line-contents
1245                     (ly:stencil-translate-axis
1246                      line-contents
1247                      (- (car (ly:stencil-extent (car stencils) X)))
1248                      X)))
1249           line-contents))))
1250
1251 (define-markup-command (line layout props args)
1252   (markup-list?)
1253   #:category align
1254   #:properties ((word-space)
1255                 (text-direction RIGHT))
1256   "Put @var{args} in a horizontal line.  The property @code{word-space}
1257 determines the space between markups in @var{args}.
1258
1259 @lilypond[verbatim,quote]
1260 \\markup {
1261   \\line {
1262     one two three
1263   }
1264 }
1265 @end lilypond"
1266   (let ((stencils (interpret-markup-list layout props args)))
1267     (if (= text-direction LEFT)
1268         (set! stencils (reverse stencils)))
1269     (stack-stencil-line
1270      word-space
1271      (remove ly:stencil-empty? stencils))))
1272
1273 (define-markup-command (concat layout props args)
1274   (markup-list?)
1275   #:category align
1276   "
1277 @cindex concatenating text
1278 @cindex ligatures in text
1279
1280 Concatenate @var{args} in a horizontal line, without spaces in between.
1281 Strings and simple markups are concatenated on the input level, allowing
1282 ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
1283 equivalent to @code{\"fi\"}.
1284
1285 @lilypond[verbatim,quote]
1286 \\markup {
1287   \\concat {
1288     one
1289     two
1290     three
1291   }
1292 }
1293 @end lilypond"
1294   (define (concat-string-args arg-list)
1295     (fold-right (lambda (arg result-list)
1296                   (let ((result (if (pair? result-list)
1297                                     (car result-list)
1298                                   '())))
1299                     (if (and (pair? arg) (eqv? (car arg) simple-markup))
1300                       (set! arg (cadr arg)))
1301                     (if (and (string? result) (string? arg))
1302                         (cons (string-append arg result) (cdr result-list))
1303                       (cons arg result-list))))
1304                 '()
1305                 arg-list))
1306
1307   (interpret-markup layout
1308                     (prepend-alist-chain 'word-space 0 props)
1309                     (make-line-markup
1310                      (make-override-lines-markup-list
1311                       (cons 'word-space
1312                             (chain-assoc-get 'word-space props))
1313                       (if (markup-command-list? args)
1314                           args
1315                           (concat-string-args args))))))
1316
1317 (define (wordwrap-stencils stencils
1318                            justify base-space line-width text-dir)
1319   "Perform simple wordwrap, return stencil of each line."
1320   (define space (if justify
1321                     ;; justify only stretches lines.
1322                     (* 0.7 base-space)
1323                     base-space))
1324   (define (stencil-space stencil line-start)
1325     (if (ly:stencil-empty? stencil X)
1326         0
1327         (cdr (ly:stencil-extent
1328               (ly:stencil-stack (if line-start
1329                                     empty-stencil
1330                                     point-stencil)
1331                                 X RIGHT stencil)
1332               X))))
1333   (define (take-list width space stencils
1334                      accumulator accumulated-width)
1335     "Return (head-list . tail) pair, with head-list fitting into width"
1336     (if (null? stencils)
1337         (cons accumulator stencils)
1338         (let* ((first (car stencils))
1339                (first-wid (stencil-space first (null? accumulator)))
1340                (newwid (+ (if (or (ly:stencil-empty? first Y)
1341                                   (ly:stencil-empty? first X))
1342                               0 space)
1343                           first-wid accumulated-width)))
1344           (if (or (null? accumulator)
1345                   (< newwid width))
1346               (take-list width space
1347                          (cdr stencils)
1348                          (cons first accumulator)
1349                          newwid)
1350               (cons accumulator stencils)))))
1351   (let loop ((lines '())
1352              (todo stencils))
1353     (let* ((line-break (take-list line-width space todo
1354                                   '() 0.0))
1355            (line-stencils (car line-break))
1356            (space-left (- line-width
1357                           (stencil-space
1358                            (stack-stencil-line 0 line-stencils)
1359                            #t)))
1360            (line-words (count (lambda (s) (not (or (ly:stencil-empty? s Y)
1361                                                    (ly:stencil-empty? s X))))
1362                               line-stencils))
1363            (line-word-space (cond ((not justify) space)
1364                                   ;; don't stretch last line of paragraph.
1365                                   ;; hmmm . bug - will overstretch the last line in some case.
1366                                   ((null? (cdr line-break))
1367                                    base-space)
1368                                   ((< line-words 2) space)
1369                                   (else (/ space-left (1- line-words)))))
1370            (line (stack-stencil-line line-word-space
1371                                      (if (= text-dir RIGHT)
1372                                          (reverse line-stencils)
1373                                          line-stencils))))
1374       (if (pair? (cdr line-break))
1375           (loop (cons line lines)
1376                 (cdr line-break))
1377           (begin
1378             (if (= text-dir LEFT)
1379                 (set! line
1380                       (ly:stencil-translate-axis
1381                        line
1382                        (- line-width (interval-end (ly:stencil-extent line X)))
1383                        X)))
1384             (reverse (cons line lines)))))))
1385
1386 (define-markup-list-command (wordwrap-internal layout props justify args)
1387   (boolean? markup-list?)
1388   #:properties ((line-width #f)
1389                 (word-space)
1390                 (text-direction RIGHT))
1391   "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
1392   (wordwrap-stencils (interpret-markup-list layout props args)
1393                      justify
1394                      word-space
1395                      (or line-width
1396                          (ly:output-def-lookup layout 'line-width))
1397                      text-direction))
1398
1399 (define-markup-command (justify layout props args)
1400   (markup-list?)
1401   #:category align
1402   #:properties ((baseline-skip)
1403                 wordwrap-internal-markup-list)
1404   "
1405 @cindex justifying text
1406
1407 Like @code{\\wordwrap}, but with lines stretched to justify the margins.
1408 Use @code{\\override #'(line-width . @var{X})} to set the line width;
1409 @var{X}@tie{}is the number of staff spaces.
1410
1411 @lilypond[verbatim,quote]
1412 \\markup {
1413   \\justify {
1414     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
1415     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1416     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1417     laboris nisi ut aliquip ex ea commodo consequat.
1418   }
1419 }
1420 @end lilypond"
1421   (stack-lines DOWN 0.0 baseline-skip
1422                (wordwrap-internal-markup-list layout props #t args)))
1423
1424 (define-markup-command (wordwrap layout props args)
1425   (markup-list?)
1426   #:category align
1427   #:properties ((baseline-skip)
1428                 wordwrap-internal-markup-list)
1429   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
1430 the line width, where @var{X} is the number of staff spaces.
1431
1432 @lilypond[verbatim,quote]
1433 \\markup {
1434   \\wordwrap {
1435     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
1436     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1437     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1438     laboris nisi ut aliquip ex ea commodo consequat.
1439   }
1440 }
1441 @end lilypond"
1442   (stack-lines DOWN 0.0 baseline-skip
1443                (wordwrap-internal-markup-list layout props #f args)))
1444
1445 (define-markup-list-command (wordwrap-string-internal layout props justify arg)
1446   (boolean? string?)
1447   #:properties ((line-width)
1448                 (word-space)
1449                 (text-direction RIGHT))
1450   "Internal markup list command used to define @code{\\justify-string} and
1451 @code{\\wordwrap-string}."
1452   (let* ((para-strings (regexp-split
1453                         (string-regexp-substitute
1454                          "\r" "\n"
1455                          (string-regexp-substitute "\r\n" "\n" arg))
1456                         "\n[ \t\n]*\n[ \t\n]*"))
1457          (list-para-words (map (lambda (str)
1458                                  (regexp-split str "[ \t\n]+"))
1459                                para-strings))
1460          (para-lines (map (lambda (words)
1461                             (let* ((stencils
1462                                     (map (lambda (x)
1463                                            (interpret-markup layout props x))
1464                                          words)))
1465                               (wordwrap-stencils stencils
1466                                                  justify word-space
1467                                                  line-width text-direction)))
1468                           list-para-words)))
1469     (apply append para-lines)))
1470
1471 (define-markup-command (wordwrap-string layout props arg)
1472   (string?)
1473   #:category align
1474   #:properties ((baseline-skip)
1475                 wordwrap-string-internal-markup-list)
1476   "Wordwrap a string.  Paragraphs may be separated with double newlines.
1477
1478 @lilypond[verbatim,quote]
1479 \\markup {
1480   \\override #'(line-width . 40)
1481   \\wordwrap-string #\"Lorem ipsum dolor sit amet, consectetur
1482       adipisicing elit, sed do eiusmod tempor incididunt ut labore
1483       et dolore magna aliqua.
1484
1485
1486       Ut enim ad minim veniam, quis nostrud exercitation ullamco
1487       laboris nisi ut aliquip ex ea commodo consequat.
1488
1489
1490       Excepteur sint occaecat cupidatat non proident, sunt in culpa
1491       qui officia deserunt mollit anim id est laborum\"
1492 }
1493 @end lilypond"
1494   (stack-lines DOWN 0.0 baseline-skip
1495                (wordwrap-string-internal-markup-list layout props #f arg)))
1496
1497 (define-markup-command (justify-string layout props arg)
1498   (string?)
1499   #:category align
1500   #:properties ((baseline-skip)
1501                 wordwrap-string-internal-markup-list)
1502   "Justify a string.  Paragraphs may be separated with double newlines
1503
1504 @lilypond[verbatim,quote]
1505 \\markup {
1506   \\override #'(line-width . 40)
1507   \\justify-string #\"Lorem ipsum dolor sit amet, consectetur
1508       adipisicing elit, sed do eiusmod tempor incididunt ut labore
1509       et dolore magna aliqua.
1510
1511
1512       Ut enim ad minim veniam, quis nostrud exercitation ullamco
1513       laboris nisi ut aliquip ex ea commodo consequat.
1514
1515
1516       Excepteur sint occaecat cupidatat non proident, sunt in culpa
1517       qui officia deserunt mollit anim id est laborum\"
1518 }
1519 @end lilypond"
1520   (stack-lines DOWN 0.0 baseline-skip
1521                (wordwrap-string-internal-markup-list layout props #t arg)))
1522
1523 (define-markup-command (wordwrap-field layout props symbol)
1524   (symbol?)
1525   #:category align
1526   "Wordwrap the data which has been assigned to @var{symbol}.
1527
1528 @lilypond[verbatim,quote]
1529 \\header {
1530   title = \"My title\"
1531   myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
1532     elit, sed do eiusmod tempor incididunt ut labore et dolore
1533     magna aliqua.  Ut enim ad minim veniam, quis nostrud
1534     exercitation ullamco laboris nisi ut aliquip ex ea commodo
1535     consequat.\"
1536 }
1537
1538 \\paper {
1539   bookTitleMarkup = \\markup {
1540     \\column {
1541       \\fill-line { \\fromproperty #'header:title }
1542       \\null
1543       \\wordwrap-field #'header:myText
1544     }
1545   }
1546 }
1547
1548 \\markup {
1549   \\null
1550 }
1551 @end lilypond"
1552   (let* ((m (chain-assoc-get symbol props)))
1553     (if (string? m)
1554         (wordwrap-string-markup layout props m)
1555         empty-stencil)))
1556
1557 (define-markup-command (justify-field layout props symbol)
1558   (symbol?)
1559   #:category align
1560   "Justify the data which has been assigned to @var{symbol}.
1561
1562 @lilypond[verbatim,quote]
1563 \\header {
1564   title = \"My title\"
1565   myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
1566     elit, sed do eiusmod tempor incididunt ut labore et dolore magna
1567     aliqua.  Ut enim ad minim veniam, quis nostrud exercitation ullamco
1568     laboris nisi ut aliquip ex ea commodo consequat.\"
1569 }
1570
1571 \\paper {
1572   bookTitleMarkup = \\markup {
1573     \\column {
1574       \\fill-line { \\fromproperty #'header:title }
1575       \\null
1576       \\justify-field #'header:myText
1577     }
1578   }
1579 }
1580
1581 \\markup {
1582   \\null
1583 }
1584 @end lilypond"
1585   (let* ((m (chain-assoc-get symbol props)))
1586     (if (string? m)
1587         (justify-string-markup layout props m)
1588         empty-stencil)))
1589
1590 (define-markup-command (combine layout props arg1 arg2)
1591   (markup? markup?)
1592   #:category align
1593   "
1594 @cindex merging text
1595
1596 Print two markups on top of each other.
1597
1598 Note: @code{\\combine} cannot take a list of markups enclosed in
1599 curly braces as an argument; the follow example will not compile:
1600
1601 @example
1602 \\combine @{ a list @}
1603 @end example
1604
1605 @lilypond[verbatim,quote]
1606 \\markup {
1607   \\fontsize #5
1608   \\override #'(thickness . 2)
1609   \\combine
1610     \\draw-line #'(0 . 4)
1611     \\arrow-head #Y #DOWN ##f
1612 }
1613 @end lilypond"
1614   (let* ((s1 (interpret-markup layout props arg1))
1615          (s2 (interpret-markup layout props arg2)))
1616     (ly:stencil-add s1 s2)))
1617
1618 ;;
1619 ;; TODO: should extract baseline-skip from each argument somehow..
1620 ;;
1621 (define-markup-command (column layout props args)
1622   (markup-list?)
1623   #:category align
1624   #:properties ((baseline-skip))
1625   "
1626 @cindex stacking text in a column
1627
1628 Stack the markups in @var{args} vertically.  The property
1629 @code{baseline-skip} determines the space between markups
1630 in @var{args}.
1631
1632 @lilypond[verbatim,quote]
1633 \\markup {
1634   \\column {
1635     one
1636     two
1637     three
1638   }
1639 }
1640 @end lilypond"
1641   (let ((arg-stencils (interpret-markup-list layout props args)))
1642     (stack-lines -1 0.0 baseline-skip
1643                  (remove ly:stencil-empty? arg-stencils))))
1644
1645 (define-markup-command (dir-column layout props args)
1646   (markup-list?)
1647   #:category align
1648   #:properties ((direction)
1649                 (baseline-skip))
1650   "
1651 @cindex changing direction of text columns
1652
1653 Make a column of @var{args}, going up or down, depending on the
1654 setting of the @code{direction} layout property.
1655
1656 @lilypond[verbatim,quote]
1657 \\markup {
1658   \\override #`(direction . ,UP) {
1659     \\dir-column {
1660       going up
1661     }
1662   }
1663   \\hspace #1
1664   \\dir-column {
1665     going down
1666   }
1667   \\hspace #1
1668   \\override #'(direction . 1) {
1669     \\dir-column {
1670       going up
1671     }
1672   }
1673 }
1674 @end lilypond"
1675   (stack-lines (if (number? direction) direction -1)
1676                0.0
1677                baseline-skip
1678                (interpret-markup-list layout props args)))
1679
1680 (define (general-column align-dir baseline mols)
1681   "Stack @var{mols} vertically, aligned to  @var{align-dir} horizontally."
1682
1683   (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols))
1684          (stacked-stencil (stack-lines -1 0.0 baseline aligned-mols))
1685          (stacked-extent (ly:stencil-extent stacked-stencil X)))
1686     (ly:stencil-translate-axis stacked-stencil (- (car stacked-extent)) X )))
1687
1688 (define-markup-command (center-column layout props args)
1689   (markup-list?)
1690   #:category align
1691   #:properties ((baseline-skip))
1692   "
1693 @cindex centering a column of text
1694
1695 Put @code{args} in a centered column.
1696
1697 @lilypond[verbatim,quote]
1698 \\markup {
1699   \\center-column {
1700     one
1701     two
1702     three
1703   }
1704 }
1705 @end lilypond"
1706   (general-column CENTER baseline-skip (interpret-markup-list layout props args)))
1707
1708 (define-markup-command (left-column layout props args)
1709   (markup-list?)
1710   #:category align
1711   #:properties ((baseline-skip))
1712  "
1713 @cindex text columns, left-aligned
1714
1715 Put @code{args} in a left-aligned column.
1716
1717 @lilypond[verbatim,quote]
1718 \\markup {
1719   \\left-column {
1720     one
1721     two
1722     three
1723   }
1724 }
1725 @end lilypond"
1726   (general-column LEFT baseline-skip (interpret-markup-list layout props args)))
1727
1728 (define-markup-command (right-column layout props args)
1729   (markup-list?)
1730   #:category align
1731   #:properties ((baseline-skip))
1732  "
1733 @cindex text columns, right-aligned
1734
1735 Put @code{args} in a right-aligned column.
1736
1737 @lilypond[verbatim,quote]
1738 \\markup {
1739   \\right-column {
1740     one
1741     two
1742     three
1743   }
1744 }
1745 @end lilypond"
1746   (general-column RIGHT baseline-skip (interpret-markup-list layout props args)))
1747
1748 (define-markup-command (vcenter layout props arg)
1749   (markup?)
1750   #:category align
1751   "
1752 @cindex vertically centering text
1753
1754 Align @code{arg} to its Y@tie{}center.
1755
1756 @lilypond[verbatim,quote]
1757 \\markup {
1758   one
1759   \\vcenter
1760   two
1761   three
1762 }
1763 @end lilypond"
1764   (let* ((mol (interpret-markup layout props arg)))
1765     (ly:stencil-aligned-to mol Y CENTER)))
1766
1767 (define-markup-command (center-align layout props arg)
1768   (markup?)
1769   #:category align
1770   "
1771 @cindex horizontally centering text
1772
1773 Align @code{arg} to its X@tie{}center.
1774
1775 @lilypond[verbatim,quote]
1776 \\markup {
1777   \\column {
1778     one
1779     \\center-align
1780     two
1781     three
1782   }
1783 }
1784 @end lilypond"
1785   (let* ((mol (interpret-markup layout props arg)))
1786     (ly:stencil-aligned-to mol X CENTER)))
1787
1788 (define-markup-command (right-align layout props arg)
1789   (markup?)
1790   #:category align
1791   "
1792 @cindex right aligning text
1793
1794 Align @var{arg} on its right edge.
1795
1796 @lilypond[verbatim,quote]
1797 \\markup {
1798   \\column {
1799     one
1800     \\right-align
1801     two
1802     three
1803   }
1804 }
1805 @end lilypond"
1806   (let* ((m (interpret-markup layout props arg)))
1807     (ly:stencil-aligned-to m X RIGHT)))
1808
1809 (define-markup-command (left-align layout props arg)
1810   (markup?)
1811   #:category align
1812   "
1813 @cindex left aligning text
1814
1815 Align @var{arg} on its left edge.
1816
1817 @lilypond[verbatim,quote]
1818 \\markup {
1819   \\column {
1820     one
1821     \\left-align
1822     two
1823     three
1824   }
1825 }
1826 @end lilypond"
1827   (let* ((m (interpret-markup layout props arg)))
1828     (ly:stencil-aligned-to m X LEFT)))
1829
1830 (define-markup-command (general-align layout props axis dir arg)
1831   (integer? number? markup?)
1832   #:category align
1833   "
1834 @cindex controlling general text alignment
1835
1836 Align @var{arg} in @var{axis} direction to the @var{dir} side.
1837
1838 @lilypond[verbatim,quote]
1839 \\markup {
1840   \\column {
1841     one
1842     \\general-align #X #LEFT
1843     two
1844     three
1845     \\null
1846     one
1847     \\general-align #X #CENTER
1848     two
1849     three
1850     \\null
1851     \\line {
1852       one
1853       \\general-align #Y #UP
1854       two
1855       three
1856     }
1857     \\null
1858     \\line {
1859       one
1860       \\general-align #Y #3.2
1861       two
1862       three
1863     }
1864   }
1865 }
1866 @end lilypond"
1867   (let* ((m (interpret-markup layout props arg)))
1868     (ly:stencil-aligned-to m axis dir)))
1869
1870 (define-markup-command (halign layout props dir arg)
1871   (number? markup?)
1872   #:category align
1873   "
1874 @cindex setting horizontal text alignment
1875
1876 Set horizontal alignment.  If @var{dir} is @w{@code{-1}}, then it is
1877 left-aligned, while @code{+1} is right.  Values in between interpolate
1878 alignment accordingly.
1879
1880 @lilypond[verbatim,quote]
1881 \\markup {
1882   \\column {
1883     one
1884     \\halign #LEFT
1885     two
1886     three
1887     \\null
1888     one
1889     \\halign #CENTER
1890     two
1891     three
1892     \\null
1893     one
1894     \\halign #RIGHT
1895     two
1896     three
1897     \\null
1898     one
1899     \\halign #-5
1900     two
1901     three
1902   }
1903 }
1904 @end lilypond"
1905   (let* ((m (interpret-markup layout props arg)))
1906     (ly:stencil-aligned-to m X dir)))
1907
1908 (define-markup-command (with-dimensions layout props x y arg)
1909   (number-pair? number-pair? markup?)
1910   #:category other
1911   "
1912 @cindex setting extent of text objects
1913
1914 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
1915   (let* ((m (interpret-markup layout props arg)))
1916     (ly:make-stencil (ly:stencil-expr m) x y)))
1917
1918 (define-markup-command (pad-around layout props amount arg)
1919   (number? markup?)
1920   #:category align
1921   "Add padding @var{amount} all around @var{arg}.
1922
1923 @lilypond[verbatim,quote]
1924 \\markup {
1925   \\box {
1926     default
1927   }
1928   \\hspace #2
1929   \\box {
1930     \\pad-around #0.5 {
1931       padded
1932     }
1933   }
1934 }
1935 @end lilypond"
1936   (let* ((m (interpret-markup layout props arg))
1937          (x (ly:stencil-extent m X))
1938          (y (ly:stencil-extent m Y)))
1939     (ly:make-stencil (ly:stencil-expr m)
1940                      (interval-widen x amount)
1941                      (interval-widen y amount))))
1942
1943 (define-markup-command (pad-x layout props amount arg)
1944   (number? markup?)
1945   #:category align
1946   "
1947 @cindex padding text horizontally
1948
1949 Add padding @var{amount} around @var{arg} in the X@tie{}direction.
1950
1951 @lilypond[verbatim,quote]
1952 \\markup {
1953   \\box {
1954     default
1955   }
1956   \\hspace #4
1957   \\box {
1958     \\pad-x #2 {
1959       padded
1960     }
1961   }
1962 }
1963 @end lilypond"
1964   (let* ((m (interpret-markup layout props arg))
1965          (x (ly:stencil-extent m X))
1966          (y (ly:stencil-extent m Y)))
1967     (ly:make-stencil (ly:stencil-expr m)
1968                      (interval-widen x amount)
1969                      y)))
1970
1971 (define-markup-command (put-adjacent layout props axis dir arg1 arg2)
1972   (integer? ly:dir? markup? markup?)
1973   #:category align
1974   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1975   (let ((m1 (interpret-markup layout props arg1))
1976         (m2 (interpret-markup layout props arg2)))
1977     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1978
1979 (define-markup-command (transparent layout props arg)
1980   (markup?)
1981   #:category other
1982   "Make @var{arg} transparent.
1983
1984 @lilypond[verbatim,quote]
1985 \\markup {
1986   \\transparent {
1987     invisible text
1988   }
1989 }
1990 @end lilypond"
1991   (let* ((m (interpret-markup layout props arg))
1992          (x (ly:stencil-extent m X))
1993          (y (ly:stencil-extent m Y)))
1994     (ly:make-stencil "" x y)))
1995
1996 (define-markup-command (pad-to-box layout props x-ext y-ext arg)
1997   (number-pair? number-pair? markup?)
1998   #:category align
1999   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space.
2000
2001 @lilypond[verbatim,quote]
2002 \\markup {
2003   \\box {
2004     default
2005   }
2006   \\hspace #4
2007   \\box {
2008     \\pad-to-box #'(0 . 10) #'(0 . 3) {
2009       padded
2010     }
2011   }
2012 }
2013 @end lilypond"
2014   (let* ((m (interpret-markup layout props arg))
2015          (x (ly:stencil-extent m X))
2016          (y (ly:stencil-extent m Y)))
2017     (ly:make-stencil (ly:stencil-expr m)
2018                      (interval-union x-ext x)
2019                      (interval-union y-ext y))))
2020
2021 (define-markup-command (hcenter-in layout props length arg)
2022   (number? markup?)
2023   #:category align
2024   "Center @var{arg} horizontally within a box of extending
2025 @var{length}/2 to the left and right.
2026
2027 @lilypond[quote,verbatim]
2028 \\new StaffGroup <<
2029   \\new Staff {
2030     \\set Staff.instrumentName = \\markup {
2031       \\hcenter-in #12
2032       Oboe
2033     }
2034     c''1
2035   }
2036   \\new Staff {
2037     \\set Staff.instrumentName = \\markup {
2038       \\hcenter-in #12
2039       Bassoon
2040     }
2041     \\clef tenor
2042     c'1
2043   }
2044 >>
2045 @end lilypond"
2046   (interpret-markup layout props
2047                     (make-pad-to-box-markup
2048                      (cons (/ length -2) (/ length 2))
2049                      '(0 . 0)
2050                      (make-center-align-markup arg))))
2051
2052 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2053 ;; property
2054 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2055
2056 (define-markup-command (property-recursive layout props symbol)
2057   (symbol?)
2058   #:category other
2059   "Print out a warning when a header field markup contains some recursive
2060 markup definition."
2061   (ly:warning "Recursive definition of property ~a detected!" symbol)
2062   empty-stencil)
2063
2064 (define-markup-command (fromproperty layout props symbol)
2065   (symbol?)
2066   #:category other
2067   "Read the @var{symbol} from property settings, and produce a stencil
2068 from the markup contained within.  If @var{symbol} is not defined, it
2069 returns an empty markup.
2070
2071 @lilypond[verbatim,quote]
2072 \\header {
2073   myTitle = \"myTitle\"
2074   title = \\markup {
2075     from
2076     \\italic
2077     \\fromproperty #'header:myTitle
2078   }
2079 }
2080 \\markup {
2081   \\null
2082 }
2083 @end lilypond"
2084   (let ((m (chain-assoc-get symbol props)))
2085     (if (markup? m)
2086         ;; prevent infinite loops by clearing the interpreted property:
2087         (interpret-markup layout (cons (list (cons symbol `(,property-recursive-markup ,symbol))) props) m)
2088         empty-stencil)))
2089
2090 (define-markup-command (on-the-fly layout props procedure arg)
2091   (procedure? markup?)
2092   #:category other
2093   "Apply the @var{procedure} markup command to @var{arg}.
2094 @var{procedure} should take a single argument."
2095   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
2096     (set-object-property! anonymous-with-signature
2097                           'markup-signature
2098                           (list markup?))
2099     (interpret-markup layout props (list anonymous-with-signature arg))))
2100
2101 (define-markup-command (footnote layout props mkup note)
2102   (markup? markup?)
2103   #:category other
2104   "Have footnote @var{note} act as an annotation to the markup @var{mkup}.
2105
2106 @lilypond[verbatim,quote]
2107 \\markup {
2108   \\auto-footnote a b
2109   \\override #'(padding . 0.2)
2110   \\auto-footnote c d
2111 }
2112 @end lilypond
2113 The footnote will not be annotated automatically."
2114   (ly:stencil-combine-at-edge
2115     (interpret-markup layout props mkup)
2116     X
2117     RIGHT
2118     (ly:make-stencil
2119       `(footnote (gensym "footnote") #f ,(interpret-markup layout props note))
2120       '(0 . 0)
2121       '(0 . 0))
2122     0.0))
2123
2124 (define-markup-command (auto-footnote layout props mkup note)
2125   (markup? markup?)
2126   #:category other
2127   #:properties ((raise 0.5)
2128                 (padding 0.0))
2129   "Have footnote @var{note} act as an annotation to the markup @var{mkup}.
2130
2131 @lilypond[verbatim,quote]
2132 \\markup {
2133   \\auto-footnote a b
2134   \\override #'(padding . 0.2)
2135   \\auto-footnote c d
2136 }
2137 @end lilypond
2138 The footnote will be annotated automatically."
2139   (let* ((markup-stencil (interpret-markup layout props mkup))
2140          (footnote-hash (gensym "footnote"))
2141          (stencil-seed 0)
2142          (gauge-stencil (interpret-markup
2143                            layout
2144                            props
2145                            ((ly:output-def-lookup
2146                                layout
2147                                'footnote-numbering-function)
2148                               stencil-seed)))
2149          (x-ext (ly:stencil-extent gauge-stencil X))
2150          (y-ext (ly:stencil-extent gauge-stencil Y))
2151          (footnote-number
2152            `(delay-stencil-evaluation
2153               ,(delay
2154                 (ly:stencil-expr
2155                   (let* ((table
2156                           (ly:output-def-lookup layout
2157                                                 'number-footnote-table))
2158                          (footnote-stencil (if (list? table)
2159                                                (assoc-get footnote-hash
2160                                                           table)
2161                                                empty-stencil))
2162                          (footnote-stencil (if (ly:stencil? footnote-stencil)
2163                                                footnote-stencil
2164                                                (begin
2165                                                  (ly:programming-error
2166 "Cannot find correct footnote for a markup object.")
2167                                                  empty-stencil)))
2168                          (gap (- (interval-length x-ext)
2169                                  (interval-length
2170                                    (ly:stencil-extent footnote-stencil X))))
2171                          (y-trans (- (+ (cdr y-ext)
2172                                         raise)
2173                                      (cdr (ly:stencil-extent footnote-stencil
2174                                                              Y)))))
2175                     (ly:stencil-translate footnote-stencil
2176                                           (cons gap y-trans)))))))
2177          (main-stencil (ly:stencil-combine-at-edge
2178                          markup-stencil
2179                          X
2180                          RIGHT
2181                          (ly:make-stencil footnote-number x-ext y-ext)
2182                          padding)))
2183   (ly:stencil-add
2184     main-stencil
2185     (ly:make-stencil
2186       `(footnote ,footnote-hash #t ,(interpret-markup layout props note))
2187       '(0 . 0)
2188       '(0 . 0)))))
2189
2190 (define-markup-command (override layout props new-prop arg)
2191   (pair? markup?)
2192   #:category other
2193   "
2194 @cindex overriding properties within text markup
2195
2196 Add the argument @var{new-prop} to the property list.  Properties
2197 may be any property supported by @rinternals{font-interface},
2198 @rinternals{text-interface} and
2199 @rinternals{instrument-specific-markup-interface}.
2200
2201 @lilypond[verbatim,quote]
2202 \\markup {
2203   \\line {
2204     \\column {
2205       default
2206       baseline-skip
2207     }
2208     \\hspace #2
2209     \\override #'(baseline-skip . 4) {
2210       \\column {
2211         increased
2212         baseline-skip
2213       }
2214     }
2215   }
2216 }
2217 @end lilypond"
2218   (interpret-markup layout (cons (list new-prop) props) arg))
2219
2220 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2221 ;; files
2222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2223
2224 (define-markup-command (verbatim-file layout props name)
2225   (string?)
2226   #:category other
2227   "Read the contents of file @var{name}, and include it verbatim.
2228
2229 @lilypond[verbatim,quote]
2230 \\markup {
2231   \\verbatim-file #\"simple.ly\"
2232 }
2233 @end lilypond"
2234   (interpret-markup layout props
2235                     (if  (ly:get-option 'safe)
2236                          "verbatim-file disabled in safe mode"
2237                          (let* ((str (ly:gulp-file name))
2238                                 (lines (string-split str #\nl)))
2239                            (make-typewriter-markup
2240                             (make-column-markup lines))))))
2241
2242 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2243 ;; fonts.
2244 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2245
2246
2247 (define-markup-command (smaller layout props arg)
2248   (markup?)
2249   #:category font
2250   "Decrease the font size relative to the current setting.
2251
2252 @lilypond[verbatim,quote]
2253 \\markup {
2254   \\fontsize #3.5 {
2255     some large text
2256     \\hspace #2
2257     \\smaller {
2258       a bit smaller
2259     }
2260     \\hspace #2
2261     more large text
2262   }
2263 }
2264 @end lilypond"
2265   (interpret-markup layout props
2266    `(,fontsize-markup -1 ,arg)))
2267
2268 (define-markup-command (larger layout props arg)
2269   (markup?)
2270   #:category font
2271   "Increase the font size relative to the current setting.
2272
2273 @lilypond[verbatim,quote]
2274 \\markup {
2275   default
2276   \\hspace #2
2277   \\larger
2278   larger
2279 }
2280 @end lilypond"
2281   (interpret-markup layout props
2282    `(,fontsize-markup 1 ,arg)))
2283
2284 (define-markup-command (finger layout props arg)
2285   (markup?)
2286   #:category font
2287   "Set @var{arg} as small numbers.
2288
2289 @lilypond[verbatim,quote]
2290 \\markup {
2291   \\finger {
2292     1 2 3 4 5
2293   }
2294 }
2295 @end lilypond"
2296   (interpret-markup layout
2297                     (cons '((font-size . -5) (font-encoding . fetaText)) props)
2298                     arg))
2299
2300 (define-markup-command (abs-fontsize layout props size arg)
2301   (number? markup?)
2302   #:category font
2303   "Use @var{size} as the absolute font size to display @var{arg}.
2304 Adjusts @code{baseline-skip} and @code{word-space} accordingly.
2305
2306 @lilypond[verbatim,quote]
2307 \\markup {
2308   default text font size
2309   \\hspace #2
2310   \\abs-fontsize #16 { text font size 16 }
2311   \\hspace #2
2312   \\abs-fontsize #12 { text font size 12 }
2313 }
2314 @end lilypond"
2315   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
2316          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
2317          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
2318          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
2319          (magnification (/ size ref-size)))
2320      (interpret-markup
2321       layout
2322       (cons
2323        `((baseline-skip . ,(* magnification ref-baseline))
2324          (word-space . ,(* magnification ref-word-space))
2325          (font-size . ,(magnification->font-size magnification)))
2326        props)
2327       arg)))
2328
2329 (define-markup-command (fontsize layout props increment arg)
2330   (number? markup?)
2331   #:category font
2332   #:properties ((font-size 0)
2333                 (word-space 1)
2334                 (baseline-skip 2))
2335   "Add @var{increment} to the font-size.  Adjusts @code{baseline-skip}
2336 accordingly.
2337
2338 @lilypond[verbatim,quote]
2339 \\markup {
2340   default
2341   \\hspace #2
2342   \\fontsize #-1.5
2343   smaller
2344 }
2345 @end lilypond"
2346   (interpret-markup
2347    layout
2348    (cons
2349     `((baseline-skip . ,(* baseline-skip (magstep increment)))
2350       (word-space . ,(* word-space (magstep increment)))
2351       (font-size . ,(+ font-size increment)))
2352     props)
2353    arg))
2354
2355 (define-markup-command (magnify layout props sz arg)
2356   (number? markup?)
2357   #:category font
2358   "
2359 @cindex magnifying text
2360
2361 Set the font magnification for its argument.  In the following
2362 example, the middle@tie{}A is 10% larger:
2363
2364 @example
2365 A \\magnify #1.1 @{ A @} A
2366 @end example
2367
2368 Note: Magnification only works if a font name is explicitly selected.
2369 Use @code{\\fontsize} otherwise.
2370
2371 @lilypond[verbatim,quote]
2372 \\markup {
2373   default
2374   \\hspace #2
2375   \\magnify #1.5 {
2376     50% larger
2377   }
2378 }
2379 @end lilypond"
2380   (interpret-markup
2381    layout
2382    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
2383    arg))
2384
2385 (define-markup-command (bold layout props arg)
2386   (markup?)
2387   #:category font
2388   "Switch to bold font-series.
2389
2390 @lilypond[verbatim,quote]
2391 \\markup {
2392   default
2393   \\hspace #2
2394   \\bold
2395   bold
2396 }
2397 @end lilypond"
2398   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
2399
2400 (define-markup-command (sans layout props arg)
2401   (markup?)
2402   #:category font
2403   "Switch to the sans serif font family.
2404
2405 @lilypond[verbatim,quote]
2406 \\markup {
2407   default
2408   \\hspace #2
2409   \\sans {
2410     sans serif
2411   }
2412 }
2413 @end lilypond"
2414   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
2415
2416 (define-markup-command (number layout props arg)
2417   (markup?)
2418   #:category font
2419   "Set font family to @code{number}, which yields the font used for
2420 time signatures and fingerings.  This font contains numbers and
2421 some punctuation; it has no letters.
2422
2423 @lilypond[verbatim,quote]
2424 \\markup {
2425   \\number {
2426     0 1 2 3 4 5 6 7 8 9 . ,
2427   }
2428 }
2429 @end lilypond"
2430   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2431
2432 (define-markup-command (roman layout props arg)
2433   (markup?)
2434   #:category font
2435   "Set font family to @code{roman}.
2436
2437 @lilypond[verbatim,quote]
2438 \\markup {
2439   \\sans \\bold {
2440     sans serif, bold
2441     \\hspace #2
2442     \\roman {
2443       text in roman font family
2444     }
2445     \\hspace #2
2446     return to sans
2447   }
2448 }
2449 @end lilypond"
2450   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
2451
2452 (define-markup-command (huge layout props arg)
2453   (markup?)
2454   #:category font
2455   "Set font size to +2.
2456
2457 @lilypond[verbatim,quote]
2458 \\markup {
2459   default
2460   \\hspace #2
2461   \\huge
2462   huge
2463 }
2464 @end lilypond"
2465   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
2466
2467 (define-markup-command (large layout props arg)
2468   (markup?)
2469   #:category font
2470   "Set font size to +1.
2471
2472 @lilypond[verbatim,quote]
2473 \\markup {
2474   default
2475   \\hspace #2
2476   \\large
2477   large
2478 }
2479 @end lilypond"
2480   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
2481
2482 (define-markup-command (normalsize layout props arg)
2483   (markup?)
2484   #:category font
2485   "Set font size to default.
2486
2487 @lilypond[verbatim,quote]
2488 \\markup {
2489   \\teeny {
2490     this is very small
2491     \\hspace #2
2492     \\normalsize {
2493       normal size
2494     }
2495     \\hspace #2
2496     teeny again
2497   }
2498 }
2499 @end lilypond"
2500   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
2501
2502 (define-markup-command (small layout props arg)
2503   (markup?)
2504   #:category font
2505   "Set font size to -1.
2506
2507 @lilypond[verbatim,quote]
2508 \\markup {
2509   default
2510   \\hspace #2
2511   \\small
2512   small
2513 }
2514 @end lilypond"
2515   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
2516
2517 (define-markup-command (tiny layout props arg)
2518   (markup?)
2519   #:category font
2520   "Set font size to -2.
2521
2522 @lilypond[verbatim,quote]
2523 \\markup {
2524   default
2525   \\hspace #2
2526   \\tiny
2527   tiny
2528 }
2529 @end lilypond"
2530   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
2531
2532 (define-markup-command (teeny layout props arg)
2533   (markup?)
2534   #:category font
2535   "Set font size to -3.
2536
2537 @lilypond[verbatim,quote]
2538 \\markup {
2539   default
2540   \\hspace #2
2541   \\teeny
2542   teeny
2543 }
2544 @end lilypond"
2545   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
2546
2547 (define-markup-command (fontCaps layout props arg)
2548   (markup?)
2549   #:category font
2550   "Set @code{font-shape} to @code{caps}
2551
2552 Note: @code{\\fontCaps} requires the installation and selection of
2553 fonts which support the @code{caps} font shape."
2554   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
2555
2556 ;; Poor man's caps
2557 (define-markup-command (smallCaps layout props arg)
2558   (markup?)
2559   #:category font
2560   "Emit @var{arg} as small caps.
2561
2562 Note: @code{\\smallCaps} does not support accented characters.
2563
2564 @lilypond[verbatim,quote]
2565 \\markup {
2566   default
2567   \\hspace #2
2568   \\smallCaps {
2569     Text in small caps
2570   }
2571 }
2572 @end lilypond"
2573   (define (char-list->markup chars lower)
2574     (let ((final-string (string-upcase (reverse-list->string chars))))
2575       (if lower
2576           (markup #:fontsize -2 final-string)
2577           final-string)))
2578   (define (make-small-caps rest-chars currents current-is-lower prev-result)
2579     (if (null? rest-chars)
2580         (make-concat-markup
2581           (reverse! (cons (char-list->markup currents current-is-lower)
2582                           prev-result)))
2583         (let* ((ch (car rest-chars))
2584                (is-lower (char-lower-case? ch)))
2585           (if (or (and current-is-lower is-lower)
2586                   (and (not current-is-lower) (not is-lower)))
2587               (make-small-caps (cdr rest-chars)
2588                                (cons ch currents)
2589                                is-lower
2590                                prev-result)
2591               (make-small-caps (cdr rest-chars)
2592                                (list ch)
2593                                is-lower
2594                                (if (null? currents)
2595                                    prev-result
2596                                    (cons (char-list->markup
2597                                             currents current-is-lower)
2598                                          prev-result)))))))
2599   (interpret-markup layout props
2600     (if (string? arg)
2601         (make-small-caps (string->list arg) (list) #f (list))
2602         arg)))
2603
2604 (define-markup-command (caps layout props arg)
2605   (markup?)
2606   #:category font
2607   "Copy of the @code{\\smallCaps} command.
2608
2609 @lilypond[verbatim,quote]
2610 \\markup {
2611   default
2612   \\hspace #2
2613   \\caps {
2614     Text in small caps
2615   }
2616 }
2617 @end lilypond"
2618   (interpret-markup layout props (make-smallCaps-markup arg)))
2619
2620 (define-markup-command (dynamic layout props arg)
2621   (markup?)
2622   #:category font
2623   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
2624 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
2625 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
2626 done in a different font.  The recommended font for this is bold and italic.
2627 @lilypond[verbatim,quote]
2628 \\markup {
2629   \\dynamic {
2630     sfzp
2631   }
2632 }
2633 @end lilypond"
2634   (interpret-markup
2635    layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2636
2637 (define-markup-command (text layout props arg)
2638   (markup?)
2639   #:category font
2640   "Use a text font instead of music symbol or music alphabet font.
2641
2642 @lilypond[verbatim,quote]
2643 \\markup {
2644   \\number {
2645     1, 2,
2646     \\text {
2647       three, four,
2648     }
2649     5
2650   }
2651 }
2652 @end lilypond"
2653
2654   ;; ugh - latin1
2655   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
2656                     arg))
2657
2658 (define-markup-command (italic layout props arg)
2659   (markup?)
2660   #:category font
2661   "Use italic @code{font-shape} for @var{arg}.
2662
2663 @lilypond[verbatim,quote]
2664 \\markup {
2665   default
2666   \\hspace #2
2667   \\italic
2668   italic
2669 }
2670 @end lilypond"
2671   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
2672
2673 (define-markup-command (typewriter layout props arg)
2674   (markup?)
2675   #:category font
2676   "Use @code{font-family} typewriter for @var{arg}.
2677
2678 @lilypond[verbatim,quote]
2679 \\markup {
2680   default
2681   \\hspace #2
2682   \\typewriter
2683   typewriter
2684 }
2685 @end lilypond"
2686   (interpret-markup
2687    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
2688
2689 (define-markup-command (upright layout props arg)
2690   (markup?)
2691   #:category font
2692   "Set @code{font-shape} to @code{upright}.  This is the opposite
2693 of @code{italic}.
2694
2695 @lilypond[verbatim,quote]
2696 \\markup {
2697   \\italic {
2698     italic text
2699     \\hspace #2
2700     \\upright {
2701       upright text
2702     }
2703     \\hspace #2
2704     italic again
2705   }
2706 }
2707 @end lilypond"
2708   (interpret-markup
2709    layout (prepend-alist-chain 'font-shape 'upright props) arg))
2710
2711 (define-markup-command (medium layout props arg)
2712   (markup?)
2713   #:category font
2714   "Switch to medium font-series (in contrast to bold).
2715
2716 @lilypond[verbatim,quote]
2717 \\markup {
2718   \\bold {
2719     some bold text
2720     \\hspace #2
2721     \\medium {
2722       medium font series
2723     }
2724     \\hspace #2
2725     bold again
2726   }
2727 }
2728 @end lilypond"
2729   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2730                     arg))
2731
2732 (define-markup-command (normal-text layout props arg)
2733   (markup?)
2734   #:category font
2735   "Set all font related properties (except the size) to get the default
2736 normal text font, no matter what font was used earlier.
2737
2738 @lilypond[verbatim,quote]
2739 \\markup {
2740   \\huge \\bold \\sans \\caps {
2741     huge bold sans caps
2742     \\hspace #2
2743     \\normal-text {
2744       huge normal
2745     }
2746     \\hspace #2
2747     as before
2748   }
2749 }
2750 @end lilypond"
2751   ;; ugh - latin1
2752   (interpret-markup layout
2753                     (cons '((font-family . roman) (font-shape . upright)
2754                             (font-series . medium) (font-encoding . latin1))
2755                           props)
2756                     arg))
2757
2758 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2759 ;; symbols.
2760 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2761
2762 (define-markup-command (musicglyph layout props glyph-name)
2763   (string?)
2764   #:category music
2765   "@var{glyph-name} is converted to a musical symbol; for example,
2766 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2767 the music font.  See @ruser{The Feta font} for a complete listing of
2768 the possible glyphs.
2769
2770 @lilypond[verbatim,quote]
2771 \\markup {
2772   \\musicglyph #\"f\"
2773   \\musicglyph #\"rests.2\"
2774   \\musicglyph #\"clefs.G_change\"
2775 }
2776 @end lilypond"
2777   (let* ((font (ly:paper-get-font layout
2778                                   (cons '((font-encoding . fetaMusic)
2779                                           (font-name . #f))
2780
2781                                                  props)))
2782          (glyph (ly:font-get-glyph font glyph-name)))
2783     (if (null? (ly:stencil-expr glyph))
2784         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2785
2786     glyph))
2787
2788 (define-markup-command (doublesharp layout props)
2789   ()
2790   #:category music
2791   "Draw a double sharp symbol.
2792
2793 @lilypond[verbatim,quote]
2794 \\markup {
2795   \\doublesharp
2796 }
2797 @end lilypond"
2798   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2799
2800 (define-markup-command (sesquisharp layout props)
2801   ()
2802   #:category music
2803   "Draw a 3/2 sharp symbol.
2804
2805 @lilypond[verbatim,quote]
2806 \\markup {
2807   \\sesquisharp
2808 }
2809 @end lilypond"
2810   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
2811
2812 (define-markup-command (sharp layout props)
2813   ()
2814   #:category music
2815   "Draw a sharp symbol.
2816
2817 @lilypond[verbatim,quote]
2818 \\markup {
2819   \\sharp
2820 }
2821 @end lilypond"
2822   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2823
2824 (define-markup-command (semisharp layout props)
2825   ()
2826   #:category music
2827   "Draw a semisharp symbol.
2828
2829 @lilypond[verbatim,quote]
2830 \\markup {
2831   \\semisharp
2832 }
2833 @end lilypond"
2834   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2835
2836 (define-markup-command (natural layout props)
2837   ()
2838   #:category music
2839   "Draw a natural symbol.
2840
2841 @lilypond[verbatim,quote]
2842 \\markup {
2843   \\natural
2844 }
2845 @end lilypond"
2846   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2847
2848 (define-markup-command (semiflat layout props)
2849   ()
2850   #:category music
2851   "Draw a semiflat symbol.
2852
2853 @lilypond[verbatim,quote]
2854 \\markup {
2855   \\semiflat
2856 }
2857 @end lilypond"
2858   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2859
2860 (define-markup-command (flat layout props)
2861   ()
2862   #:category music
2863   "Draw a flat symbol.
2864
2865 @lilypond[verbatim,quote]
2866 \\markup {
2867   \\flat
2868 }
2869 @end lilypond"
2870   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2871
2872 (define-markup-command (sesquiflat layout props)
2873   ()
2874   #:category music
2875   "Draw a 3/2 flat symbol.
2876
2877 @lilypond[verbatim,quote]
2878 \\markup {
2879   \\sesquiflat
2880 }
2881 @end lilypond"
2882   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2883
2884 (define-markup-command (doubleflat layout props)
2885   ()
2886   #:category music
2887   "Draw a double flat symbol.
2888
2889 @lilypond[verbatim,quote]
2890 \\markup {
2891   \\doubleflat
2892 }
2893 @end lilypond"
2894   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2895
2896 (define-markup-command (with-color layout props color arg)
2897   (color? markup?)
2898   #:category other
2899   "
2900 @cindex coloring text
2901
2902 Draw @var{arg} in color specified by @var{color}.
2903
2904 @lilypond[verbatim,quote]
2905 \\markup {
2906   \\with-color #red
2907   red
2908   \\hspace #2
2909   \\with-color #green
2910   green
2911   \\hspace #2
2912   \\with-color #blue
2913   blue
2914 }
2915 @end lilypond"
2916   (let ((stil (interpret-markup layout props arg)))
2917     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2918                      (ly:stencil-extent stil X)
2919                      (ly:stencil-extent stil Y))))
2920
2921 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2922 ;; glyphs
2923 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2924
2925 (define-markup-command (arrow-head layout props axis dir filled)
2926   (integer? ly:dir? boolean?)
2927   #:category graphic
2928   "Produce an arrow head in specified direction and axis.
2929 Use the filled head if @var{filled} is specified.
2930 @lilypond[verbatim,quote]
2931 \\markup {
2932   \\fontsize #5 {
2933     \\general-align #Y #DOWN {
2934       \\arrow-head #Y #UP ##t
2935       \\arrow-head #Y #DOWN ##f
2936       \\hspace #2
2937       \\arrow-head #X #RIGHT ##f
2938       \\arrow-head #X #LEFT ##f
2939     }
2940   }
2941 }
2942 @end lilypond"
2943   (let*
2944       ((name (format #f "arrowheads.~a.~a~a"
2945                      (if filled
2946                          "close"
2947                          "open")
2948                      axis
2949                      dir)))
2950     (ly:font-get-glyph
2951      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2952                                      props))
2953      name)))
2954
2955 (define-markup-command (lookup layout props glyph-name)
2956   (string?)
2957   #:category other
2958   "Lookup a glyph by name.
2959
2960 @lilypond[verbatim,quote]
2961 \\markup {
2962   \\override #'(font-encoding . fetaBraces) {
2963     \\lookup #\"brace200\"
2964     \\hspace #2
2965     \\rotate #180
2966     \\lookup #\"brace180\"
2967   }
2968 }
2969 @end lilypond"
2970   (ly:font-get-glyph (ly:paper-get-font layout props)
2971                      glyph-name))
2972
2973 (define-markup-command (char layout props num)
2974   (integer?)
2975   #:category other
2976   "Produce a single character.  Characters encoded in hexadecimal
2977 format require the prefix @code{#x}.
2978
2979 @lilypond[verbatim,quote]
2980 \\markup {
2981   \\char #65 \\char ##x00a9
2982 }
2983 @end lilypond"
2984   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2985
2986 (define number->mark-letter-vector (make-vector 25 #\A))
2987
2988 (do ((i 0 (1+ i))
2989      (j 0 (1+ j)))
2990     ((>= i 26))
2991   (if (= i (- (char->integer #\I) (char->integer #\A)))
2992       (set! i (1+ i)))
2993   (vector-set! number->mark-letter-vector j
2994                (integer->char (+ i (char->integer #\A)))))
2995
2996 (define number->mark-alphabet-vector (list->vector
2997   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2998
2999 (define (number->markletter-string vec n)
3000   "Double letters for big marks."
3001   (let* ((lst (vector-length vec)))
3002
3003     (if (>= n lst)
3004         (string-append (number->markletter-string vec (1- (quotient n lst)))
3005                        (number->markletter-string vec (remainder n lst)))
3006         (make-string 1 (vector-ref vec n)))))
3007
3008 (define-markup-command (markletter layout props num)
3009   (integer?)
3010   #:category other
3011   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
3012 (skipping letter@tie{}I), and continue with double letters.
3013
3014 @lilypond[verbatim,quote]
3015 \\markup {
3016   \\markletter #8
3017   \\hspace #2
3018   \\markletter #26
3019 }
3020 @end lilypond"
3021   (ly:text-interface::interpret-markup layout props
3022     (number->markletter-string number->mark-letter-vector num)))
3023
3024 (define-markup-command (markalphabet layout props num)
3025   (integer?)
3026   #:category other
3027    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
3028 and continue with double letters.
3029
3030 @lilypond[verbatim,quote]
3031 \\markup {
3032   \\markalphabet #8
3033   \\hspace #2
3034   \\markalphabet #26
3035 }
3036 @end lilypond"
3037    (ly:text-interface::interpret-markup layout props
3038      (number->markletter-string number->mark-alphabet-vector num)))
3039
3040 (define-public (horizontal-slash-interval num forward number-interval mag)
3041   (if forward
3042     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
3043           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
3044           (else (interval-widen number-interval (* mag 0.25))))
3045     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
3046           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
3047           (else (interval-widen number-interval (* mag 0.25))))
3048   ))
3049
3050 (define-public (adjust-slash-stencil num forward stencil mag)
3051   (if forward
3052     (cond ((= num 2)
3053               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
3054           ((= num 3)
3055               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
3056           ;((= num 5)
3057               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
3058           ;((= num 7)
3059           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
3060           (else stencil))
3061     (cond ((= num 6)
3062               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
3063           ;((= num 8)
3064           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
3065           (else stencil))
3066   )
3067 )
3068
3069 (define (slashed-digit-internal layout props num forward font-size thickness)
3070   (let* ((mag (magstep font-size))
3071          (thickness (* mag
3072                        (ly:output-def-lookup layout 'line-thickness)
3073                        thickness))
3074          ; backward slashes might use slope and point in the other direction!
3075          (dy (* mag (if forward 0.4 -0.4)))
3076          (number-stencil (interpret-markup layout
3077                                            (prepend-alist-chain 'font-encoding 'fetaText props)
3078                                            (number->string num)))
3079          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
3080          (center (interval-center (ly:stencil-extent number-stencil Y)))
3081          ; Use the real extents of the slash, not the whole number, because we
3082          ; might translate the slash later on!
3083          (num-y (interval-widen (cons center center) (abs dy)))
3084          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
3085          (slash-stencil (if is-sane
3086                             (make-line-stencil thickness
3087                                          (car num-x) (- (interval-center num-y) dy)
3088                                          (cdr num-x) (+ (interval-center num-y) dy))
3089                             #f)))
3090     (if (ly:stencil? slash-stencil)
3091       (begin
3092         ; for some numbers we need to shift the slash/backslash up or down to make
3093         ; the slashed digit look better
3094         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
3095         (set! number-stencil
3096           (ly:stencil-add number-stencil slash-stencil)))
3097       (ly:warning "Unable to create slashed digit ~a" num))
3098     number-stencil))
3099
3100
3101 (define-markup-command (slashed-digit layout props num)
3102   (integer?)
3103   #:category other
3104   #:properties ((font-size 0)
3105                 (thickness 1.6))
3106   "
3107 @cindex slashed digits
3108
3109 A feta number, with slash.  This is for use in the context of
3110 figured bass notation.
3111 @lilypond[verbatim,quote]
3112 \\markup {
3113   \\slashed-digit #5
3114   \\hspace #2
3115   \\override #'(thickness . 3)
3116   \\slashed-digit #7
3117 }
3118 @end lilypond"
3119   (slashed-digit-internal layout props num #t font-size thickness))
3120
3121 (define-markup-command (backslashed-digit layout props num)
3122   (integer?)
3123   #:category other
3124   #:properties ((font-size 0)
3125                 (thickness 1.6))
3126   "
3127 @cindex backslashed digits
3128
3129 A feta number, with backslash.  This is for use in the context of
3130 figured bass notation.
3131 @lilypond[verbatim,quote]
3132 \\markup {
3133   \\backslashed-digit #5
3134   \\hspace #2
3135   \\override #'(thickness . 3)
3136   \\backslashed-digit #7
3137 }
3138 @end lilypond"
3139   (slashed-digit-internal layout props num #f font-size thickness))
3140
3141 ;; eyeglasses
3142 (define eyeglassespath
3143   '((moveto 0.42 0.77)
3144     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
3145     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
3146     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
3147     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
3148     (closepath)
3149     (moveto 2.07 0.77)
3150     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
3151     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
3152     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
3153     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
3154     (closepath)
3155     (moveto 1.025 0.935)
3156     (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33)
3157     (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33)
3158     (moveto -0.68 0.77)
3159     (rlineto 0.66 1.43)
3160     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)
3161     (moveto 2.07 0.77)
3162     (rlineto 0.66 1.43)
3163     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)))
3164
3165 (define-markup-command (eyeglasses layout props)
3166   ()
3167   #:category other
3168   "Prints out eyeglasses, indicating strongly to look at the conductor.
3169 @lilypond[verbatim,quote]
3170 \\markup { \\eyeglasses }
3171 @end lilypond"
3172   (interpret-markup layout props
3173     (make-override-markup '(line-cap-style . butt)
3174       (make-path-markup 0.15 eyeglassespath))))
3175
3176 (define-markup-command (left-brace layout props size)
3177   (number?)
3178   #:category other
3179   "
3180 A feta brace in point size @var{size}.
3181
3182 @lilypond[verbatim,quote]
3183 \\markup {
3184   \\left-brace #35
3185   \\hspace #2
3186   \\left-brace #45
3187 }
3188 @end lilypond"
3189   (let* ((font (ly:paper-get-font layout
3190                                   (cons '((font-encoding . fetaBraces)
3191                                           (font-name . #f))
3192                                         props)))
3193          (glyph-count (1- (ly:otf-glyph-count font)))
3194          (scale (ly:output-def-lookup layout 'output-scale))
3195          (scaled-size (/ (ly:pt size) scale))
3196          (glyph (lambda (n)
3197                   (ly:font-get-glyph font (string-append "brace"
3198                                                          (number->string n)))))
3199          (get-y-from-brace (lambda (brace)
3200                              (interval-length
3201                               (ly:stencil-extent (glyph brace) Y))))
3202          (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size))
3203          (glyph-found (glyph find-brace)))
3204
3205     (if (or (null? (ly:stencil-expr glyph-found))
3206             (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
3207             (> scaled-size (interval-length
3208                             (ly:stencil-extent (glyph glyph-count) Y))))
3209         (begin
3210           (ly:warning (_ "no brace found for point size ~S ") size)
3211           (ly:warning (_ "defaulting to ~S pt")
3212                       (/ (* scale (interval-length
3213                                    (ly:stencil-extent glyph-found Y)))
3214                          (ly:pt 1)))))
3215     glyph-found))
3216
3217 (define-markup-command (right-brace layout props size)
3218   (number?)
3219   #:category other
3220   "
3221 A feta brace in point size @var{size}, rotated 180 degrees.
3222
3223 @lilypond[verbatim,quote]
3224 \\markup {
3225   \\right-brace #45
3226   \\hspace #2
3227   \\right-brace #35
3228 }
3229 @end lilypond"
3230   (interpret-markup layout props (markup #:rotate 180 #:left-brace size)))
3231
3232 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3233 ;; the note command.
3234 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3235
3236 ;; TODO: better syntax.
3237
3238 (define-markup-command (note-by-number layout props log dot-count dir)
3239   (number? number? number?)
3240   #:category music
3241   #:properties ((font-size 0)
3242                 (flag-style '())
3243                 (style '()))
3244   "
3245 @cindex notes within text by log and dot-count
3246
3247 Construct a note symbol, with stem and flag.  By using fractional values for
3248 @var{dir}, longer or shorter stems can be obtained.
3249 Supports all note-head-styles.
3250 Supported flag-styles are @code{default}, @code{old-straight-flag} and
3251 @code{modern-straight-flag}.
3252
3253 @lilypond[verbatim,quote]
3254 \\markup {
3255   \\note-by-number #3 #0 #DOWN
3256   \\hspace #2
3257   \\note-by-number #1 #2 #0.8
3258 }
3259 @end lilypond"
3260   (define (get-glyph-name-candidates dir log style)
3261     (map (lambda (dir-name)
3262                    (format #f "noteheads.~a~a" dir-name
3263                                    (if (and (symbol? style)
3264                                             (not (equal? 'default style)))
3265                                        (select-head-glyph style (min log 2))
3266                                        (min log 2))))
3267                  (list (if (= dir UP) "u" "d")
3268                        "s")))
3269
3270   (define (get-glyph-name font cands)
3271     (if (null? cands)
3272                 ""
3273                 (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
3274                     (get-glyph-name font (cdr cands))
3275                     (car cands))))
3276
3277   (define (buildflags flag-stencil remain curr-stencil spacing)
3278      ;; Function to recursively create a stencil with @code{remain} flags
3279      ;; from the single-flag stencil @code{curr-stencil}, which is already
3280      ;; translated to the position of the previous flag position.
3281      ;;
3282      ;; Copy and paste from /scm/flag-styles.scm
3283     (if (> remain 0)
3284         (let* ((translated-stencil
3285                  (ly:stencil-translate-axis curr-stencil spacing Y))
3286                (new-stencil (ly:stencil-add flag-stencil translated-stencil)))
3287           (buildflags new-stencil (- remain 1) translated-stencil spacing))
3288         flag-stencil))
3289
3290   (define (straight-flag-mrkp flag-thickness flag-spacing
3291                                 upflag-angle upflag-length
3292                                 downflag-angle downflag-length
3293                                 dir)
3294   ;; Create a stencil for a straight flag.  @var{flag-thickness} and
3295   ;; @var{flag-spacing} are given in staff spaces, @var{upflag-angle} and
3296   ;; @var{downflag-angle} are given in degrees, and @var{upflag-length} and
3297   ;; @var{downflag-length} are given in staff spaces.
3298   ;;
3299   ;; All lengths are scaled according to the font size of the note.
3300   ;;
3301   ;; From /scm/flag-styles.scm, modified to fit here.
3302
3303       (let* ((stem-up (> dir 0))
3304              ; scale with the note size
3305              (factor (magstep font-size))
3306              (stem-thickness (* factor 0.1))
3307              (line-thickness (ly:output-def-lookup layout 'line-thickness))
3308              (half-stem-thickness (/ (* stem-thickness line-thickness) 2))
3309              (raw-length (if stem-up upflag-length downflag-length))
3310              (angle (if stem-up upflag-angle downflag-angle))
3311              (flag-length (+ (* raw-length factor) half-stem-thickness))
3312              (flag-end (polar->rectangular flag-length angle))
3313              (thickness (* flag-thickness factor))
3314              (thickness-offset (cons 0 (* -1 thickness dir)))
3315              (spacing (* -1 flag-spacing factor dir))
3316              (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
3317              ; The points of a round-filled-polygon need to be given in
3318              ; clockwise order, otherwise the polygon will be enlarged by
3319              ; blot-size*2!
3320              (points (if stem-up (list start flag-end
3321                                        (offset-add flag-end thickness-offset)
3322                                        (offset-add start thickness-offset))
3323                                  (list start
3324                                        (offset-add start thickness-offset)
3325                                        (offset-add flag-end thickness-offset)
3326                                        flag-end)))
3327              (stencil (ly:round-filled-polygon points half-stem-thickness))
3328              ; Log for 1/8 is 3, so we need to subtract 3
3329              (flag-stencil (buildflags stencil (- log 3) stencil spacing)))
3330         flag-stencil))
3331
3332   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
3333                                                  props)))
3334          (size-factor (magstep font-size))
3335          (blot (ly:output-def-lookup layout 'blot-diameter))
3336          (head-glyph-name
3337            (let ((result (get-glyph-name font
3338                            (get-glyph-name-candidates
3339                              (sign dir) log style))))
3340              (if (string-null? result)
3341                  ;; If no glyph name can be found, select default heads.
3342                  ;; Though this usually means an unsupported style has been
3343                  ;; chosen, it also prevents unrelated 'style settings from
3344                  ;; other grobs (e.g., TextSpanner and TimeSignature) leaking
3345                  ;; into markup.
3346                  (get-glyph-name font
3347                    (get-glyph-name-candidates
3348                      (sign dir) log 'default))
3349                  result)))
3350          (head-glyph (ly:font-get-glyph font head-glyph-name))
3351          (ancient-flags? (or (eq? style 'mensural) (eq? style 'neomensural)))
3352          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
3353          (stem-length (* size-factor (max 3 (- log 1))))
3354          ;; With ancient-flags we want a tighter stem
3355          (stem-thickness (* size-factor (if ancient-flags? 0.1 0.13)))
3356          (stemy (* dir stem-length))
3357          (attach-off (cons (interval-index
3358                              (ly:stencil-extent head-glyph X)
3359                              (* (sign dir) (car attach-indices)))
3360                            ; fixme, this is inconsistent between X & Y.
3361                            (* (sign dir)
3362                               (interval-index
3363                                (ly:stencil-extent head-glyph Y)
3364                                (cdr attach-indices)))))
3365          ;; For a tighter stem (with ancient-flags) the stem-width has to be
3366          ;; adjusted.
3367          (stem-X-corr (if ancient-flags? (* 0.5 dir stem-thickness) 0))
3368          (stem-glyph (and (> log 0)
3369                           (ly:round-filled-box
3370                             (ordered-cons (+ stem-X-corr (car attach-off))
3371                                   (+ stem-X-corr (car attach-off)
3372                                      (* (- (sign dir)) stem-thickness)))
3373                             (cons (min stemy (cdr attach-off))
3374                                   (max stemy (cdr attach-off)))
3375                             (/ stem-thickness 3))))
3376          (dot (ly:font-get-glyph font "dots.dot"))
3377          (dotwid (interval-length (ly:stencil-extent dot X)))
3378          (dots (and (> dot-count 0)
3379                     (apply ly:stencil-add
3380                            (map (lambda (x)
3381                                   (ly:stencil-translate-axis
3382                                    dot (* 2 x dotwid) X))
3383                                 (iota dot-count)))))
3384          ;; Straight-flags. Values taken from /scm/flag-style.scm
3385          (modern-straight-flag (straight-flag-mrkp 0.55 1 -18 1.1 22 1.2 dir))
3386          (old-straight-flag (straight-flag-mrkp 0.55 1 -45 1.2 45 1.4 dir))
3387          ;; Calculate a corrective to avoid a gap between
3388          ;; straight-flags and the stem.
3389          (flag-style-Y-corr (if (or (eq? flag-style 'modern-straight-flag)
3390                                     (eq? flag-style 'old-straight-flag))
3391                                 (/ blot 10 (* -1 dir))
3392                                 0))
3393          (flaggl (and (> log 2)
3394                       (ly:stencil-translate
3395                         (cond ((eq? flag-style 'modern-straight-flag)
3396                                modern-straight-flag)
3397                               ((eq? flag-style 'old-straight-flag)
3398                                old-straight-flag)
3399                               (else
3400                                (ly:font-get-glyph font
3401                                  (format #f (if ancient-flags?
3402                                                 "flags.mensural~a2~a"
3403                                                 "flags.~a~a")
3404                                             (if (> dir 0) "u" "d")
3405                                             log))))
3406                         (cons (+ (car attach-off)
3407                                  ;; For tighter stems (with ancient-flags) the
3408                                  ;; flag has to be adjusted different.
3409                                  (if (and (not ancient-flags?) (< dir 0))
3410                                      stem-thickness
3411                                      0))
3412                               (+ stemy flag-style-Y-corr))))))
3413
3414     ;; If there is a flag on an upstem and the stem is short, move the dots
3415     ;; to avoid the flag.  16th notes get a special case because their flags
3416     ;; hang lower than any other flags.
3417     ;; Not with ancient flags or straight-flags.
3418     (if (and dots (> dir 0) (> log 2)
3419                      (or (eq? flag-style 'default) (null? flag-style))
3420                      (not ancient-flags?)
3421                      (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
3422                 (set! dots (ly:stencil-translate-axis dots 0.5 X)))
3423     (if flaggl
3424         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
3425     (if (ly:stencil? stem-glyph)
3426         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
3427         (set! stem-glyph head-glyph))
3428     (if (ly:stencil? dots)
3429         (set! stem-glyph
3430               (ly:stencil-add
3431                 (ly:stencil-translate-axis
3432                   dots
3433                   (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
3434                   X)
3435                 stem-glyph)))
3436     stem-glyph))
3437
3438 (define-public log2
3439   (let ((divisor (log 2)))
3440     (lambda (z) (inexact->exact (/ (log z) divisor)))))
3441
3442 (define (parse-simple-duration duration-string)
3443   "Parse the `duration-string', e.g. ''4..'' or ''breve.'',
3444 and return a (log dots) list."
3445   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)")
3446                             duration-string)))
3447     (if (and match (string=? duration-string (match:substring match 0)))
3448         (let ((len (match:substring match 1))
3449               (dots (match:substring match 2)))
3450           (list (cond ((string=? len "breve") -1)
3451                       ((string=? len "longa") -2)
3452                       ((string=? len "maxima") -3)
3453                       (else (log2 (string->number len))))
3454                 (if dots (string-length dots) 0)))
3455         (ly:error (_ "not a valid duration string: ~a") duration-string))))
3456
3457 (define-markup-command (note layout props duration dir)
3458   (string? number?)
3459   #:category music
3460   #:properties (note-by-number-markup)
3461   "
3462 @cindex notes within text by string
3463
3464 This produces a note with a stem pointing in @var{dir} direction, with
3465 the @var{duration} for the note head type and augmentation dots.  For
3466 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
3467 a shortened down stem.
3468
3469 @lilypond[verbatim,quote]
3470 \\markup {
3471   \\override #'(style . cross) {
3472     \\note #\"4..\" #UP
3473   }
3474   \\hspace #2
3475   \\note #\"breve\" #0
3476 }
3477 @end lilypond"
3478   (let ((parsed (parse-simple-duration duration)))
3479     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
3480
3481 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3482 ;; the rest command.
3483 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3484
3485 (define-markup-command (rest-by-number layout props log dot-count)
3486   (number? number?)
3487   #:category music
3488   #:properties ((font-size 0)
3489                 (style '())
3490                 (multi-measure-rest #f))
3491   "
3492 @cindex rests or multi-measure-rests within text by log and dot-count
3493
3494 A rest or multi-measure-rest symbol.
3495
3496 @lilypond[verbatim,quote]
3497 \\markup {
3498   \\rest-by-number #3 #2
3499   \\hspace #2
3500   \\rest-by-number #0 #1
3501   \\hspace #2
3502   \\override #'(multi-measure-rest . #t)
3503   \\rest-by-number #0 #0
3504 }
3505 @end lilypond"
3506
3507   (define (get-glyph-name-candidates log style)
3508     (let* (;; Choose the style-string to be added.
3509            ;; If no glyph exists, select others for the specified styles
3510            ;; otherwise defaulting.
3511            (style-strg
3512              (cond (
3513                    ;; 'baroque needs to be special-cased, otherwise
3514                    ;; `select-head-glyph´ would catch neomensural-glyphs for
3515                    ;; this style, if (< log 0).
3516                    (eq? style 'baroque)
3517                     (string-append (number->string log) ""))
3518                    ((eq? style 'petrucci)
3519                     (string-append (number->string log) "mensural"))
3520                     ;; In other cases `select-head-glyph´ from output-lib.scm
3521                     ;; works for rest-glyphs, too.
3522                    ((and (symbol? style) (not (eq? style 'default)))
3523                     (select-head-glyph style log))
3524                    (else log)))
3525            ;; Choose ledgered glyphs for whole and half rest.
3526            ;; Except for the specified styles, logs and MultiMeasureRests.
3527            (ledger-style-rests
3528              (if (and (or (list? style)
3529                           (not (member style
3530                                   '(neomensural mensural petrucci))))
3531                       (not multi-measure-rest)
3532                       (or (= log 0) (= log 1)))
3533                 "o"
3534                 "")))
3535       (format #f "rests.~a~a" style-strg ledger-style-rests)))
3536
3537   (define (get-glyph-name font cands)
3538      (if (ly:stencil-empty? (ly:font-get-glyph font cands))
3539         ""
3540         cands))
3541
3542   (let* ((font
3543            (ly:paper-get-font layout
3544              (cons '((font-encoding . fetaMusic)) props)))
3545          (rest-glyph-name
3546             (let ((result
3547                     (get-glyph-name font
3548                       (get-glyph-name-candidates log style))))
3549               (if (string-null? result)
3550                 ;; If no glyph name can be found, select default rests.  Though
3551                 ;; this usually means an unsupported style has been chosen, it
3552                 ;; also prevents unrelated 'style settings from other grobs
3553                 ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
3554                 (get-glyph-name font (get-glyph-name-candidates log 'default))
3555                 result)))
3556          (rest-glyph (ly:font-get-glyph font rest-glyph-name))
3557          (dot (ly:font-get-glyph font "dots.dot"))
3558          (dot-width (interval-length (ly:stencil-extent dot X)))
3559          (dots (and (> dot-count 0)
3560                     (apply ly:stencil-add
3561                            (map (lambda (x)
3562                                   (ly:stencil-translate-axis
3563                                    dot (* 2 x dot-width) X))
3564                                 (iota dot-count))))))
3565
3566     ;; Apart from mensural-, neomensural- and petrucci-style ledgered
3567     ;; glyphs are taken for whole and half rests.
3568     ;; If they are dotted, move the dots in X-direction to avoid collision.
3569     (if (and dots
3570              (< log 2)
3571              (>= log 0)
3572              (not (member style '(neomensural mensural petrucci))))
3573        (set! dots (ly:stencil-translate-axis dots dot-width X)))
3574
3575     ;; Add dots to the rest-glyph.
3576     ;;
3577     ;; Not sure how to vertical align dots.
3578     ;; For now the dots are centered for half, whole or longer rests.
3579     ;; Otherwise placed near the top of the rest.
3580     ;;
3581     ;; Dots for rests with (< log 0) dots are allowed, but not
3582     ;; if multi-measure-rest is set #t.
3583     (if (and (not multi-measure-rest) dots)
3584         (set! rest-glyph
3585               (ly:stencil-add
3586                (ly:stencil-translate
3587                    dots
3588                         (cons
3589                            (+ (cdr (ly:stencil-extent rest-glyph X)) dot-width)
3590                            (if (< log 2)
3591                              (interval-center (ly:stencil-extent rest-glyph Y))
3592                              (- (interval-end (ly:stencil-extent rest-glyph Y))
3593                                 (/ (* 2 dot-width) 3)))))
3594                rest-glyph)))
3595     rest-glyph))
3596
3597 (define-markup-command (rest layout props duration)
3598   (string?)
3599   #:category music
3600   #:properties ((style '())
3601                 (multi-measure-rest #f)
3602                 (multi-measure-rest-number #t)
3603                 (word-space 0.6))
3604   "
3605 @cindex rests or multi-measure-rests within text by string
3606
3607 This produces a rest, with the @var{duration} for the rest type and
3608 augmentation dots.
3609 @code{\"breve\"}, @code{\"longa\"} and @code{\"maxima\"} are valid
3610 input-strings.
3611
3612 Printing MultiMeasureRests could be enabled with
3613 @code{\\override #'(multi-measure-rest . #t)}
3614 If MultiMeasureRests are taken, the MultiMeasureRestNumber is printed above.
3615 This is enabled for all styles using default-glyphs.
3616 Could be disabled with @code{\\override #'(multi-measure-rest-number . #f)}
3617
3618 @lilypond[verbatim,quote]
3619 \\markup {
3620   \\rest #\"4..\"
3621   \\hspace #2
3622   \\rest #\"breve\"
3623   \\hspace #2
3624   \\override #'(multi-measure-rest . #t)
3625   {
3626   \\rest #\"7\"
3627   \\hspace #2
3628   \\override #'(multi-measure-rest-number . #f)
3629   \\rest #\"7\"
3630   }
3631 }
3632 @end lilypond"
3633   ;; Get the number of mmr-glyphs.
3634   ;; Store them in a list.
3635   ;; example: (mmr-numbers 25) -> '(3 0 0 1)
3636   (define (mmr-numbers nmbr)
3637       (let* ((8-bar-glyph (floor (/ nmbr 8)))
3638              (8-remainder (remainder nmbr 8))
3639              (4-bar-glyph (floor (/ 8-remainder 4)))
3640              (4-remainder (remainder nmbr 4))
3641              (2-bar-glyph (floor (/ 4-remainder 2)))
3642              (2-remainder (remainder 4-remainder 2))
3643              (1-bar-glyph (floor (/ 2-remainder 1))))
3644        (list 8-bar-glyph 4-bar-glyph 2-bar-glyph 1-bar-glyph)))
3645
3646   ;; Get the correct mmr-glyphs.
3647   ;; Store them in a list.
3648   ;; example:
3649   ;; (get-mmr-glyphs '(1 0 1 0) '("rests.M3" "rests.M2" "rests.M1" "rests.0"))
3650   ;; -> ("rests.M3" "rests.M1")
3651   (define (get-mmr-glyphs lst1 lst2)
3652      (define (helper l1 l2 l3)
3653         (if (null? l1)
3654            (reverse l3)
3655            (helper (cdr l1)
3656                    (cdr l2)
3657                    (append (make-list (car l1) (car l2)) l3))))
3658       (helper lst1 lst2 '()))
3659
3660   ;; If duration is not valid, print a warning and return empty-stencil
3661   (if (or (and (not (integer? (car (parse-simple-duration duration))))
3662                (not multi-measure-rest))
3663           (and (= (string-length (car (string-split duration #\. ))) 1)
3664                (= (string->number (car (string-split duration #\. ))) 0)))
3665     (begin
3666       (ly:warning (_ "not a valid duration string: ~a - ignoring") duration)
3667       empty-stencil)
3668     (let* (
3669        ;; For simple rests:
3670            ;; Get a (log dots) list.
3671            (parsed (parse-simple-duration duration))
3672            ;; Create the rest-stencil
3673            (stil
3674               (rest-by-number-markup layout props (car parsed) (cadr parsed)))
3675        ;; For MultiMeasureRests:
3676            ;; Get the duration-part of duration
3677            (dur-part-string (car (string-split duration #\. )))
3678            ;; Get the duration of MMR:
3679            ;; If not a number (eg. "maxima") calculate it.
3680            (mmr-duration
3681              (or (string->number dur-part-string) (expt 2 (abs (car parsed)))))
3682            ;; Get a list of the correct number of each mmr-glyph.
3683            (count-mmr-glyphs-list (mmr-numbers mmr-duration))
3684            ;; Create a list of mmr-stencils,
3685            ;; translating the glyph for a whole rest.
3686            (mmr-stils-list
3687               (map
3688                  (lambda (x)
3689                     (let ((single-mmr-stil
3690                             (rest-by-number-markup layout props (* -1 x) 0)))
3691                        (if (= x 0)
3692                           (ly:stencil-translate-axis
3693                             single-mmr-stil
3694                             ;; Ugh, hard-coded, why 1?
3695                             1
3696                             Y)
3697                            single-mmr-stil)))
3698                  (get-mmr-glyphs count-mmr-glyphs-list (reverse (iota 4)))))
3699             ;; Adjust the space between the mmr-glyphs,
3700             ;; if not default-glyphs are used.
3701             (word-space (if (member style
3702                                     '(neomensural mensural petrucci))
3703                            (/ (* word-space 2) 3)
3704                            word-space))
3705             ;; Create the final mmr-stencil
3706             ;; via `stack-stencil-line´ from /scm/markup.scm
3707             (mmr-stil (stack-stencil-line word-space mmr-stils-list)))
3708
3709       ;; Print the number above a multi-measure-rest
3710       ;; Depends on duration, style and multi-measure-rest-number set #t
3711       (if (and multi-measure-rest
3712                multi-measure-rest-number
3713                (> mmr-duration 1)
3714                (not (member style '(neomensural mensural petrucci))))
3715          (let* ((mmr-stil-x-center
3716                    (interval-center (ly:stencil-extent mmr-stil X)))
3717                 (duration-markup
3718                    (markup
3719                       #:fontsize -2
3720                       #:override '(font-encoding . fetaText)
3721                       (number->string mmr-duration)))
3722                 (mmr-number-stil
3723                    (interpret-markup layout props duration-markup))
3724                 (mmr-number-stil-x-center
3725                    (interval-center (ly:stencil-extent mmr-number-stil X))))
3726
3727          (set! mmr-stil (ly:stencil-combine-at-edge
3728                            mmr-stil
3729                            Y UP
3730                            (ly:stencil-translate-axis
3731                               mmr-number-stil
3732                               (- mmr-stil-x-center mmr-number-stil-x-center)
3733                               X)
3734                            ;; Ugh, hardcoded
3735                            0.8))))
3736     (if multi-measure-rest
3737        mmr-stil
3738        stil))))
3739
3740 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3741 ;; translating.
3742 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3743
3744 (define-markup-command (lower layout props amount arg)
3745   (number? markup?)
3746   #:category align
3747   "
3748 @cindex lowering text
3749
3750 Lower @var{arg} by the distance @var{amount}.
3751 A negative @var{amount} indicates raising; see also @code{\\raise}.
3752
3753 @lilypond[verbatim,quote]
3754 \\markup {
3755   one
3756   \\lower #3
3757   two
3758   three
3759 }
3760 @end lilypond"
3761   (ly:stencil-translate-axis (interpret-markup layout props arg)
3762                              (- amount) Y))
3763
3764 (define-markup-command (translate-scaled layout props offset arg)
3765   (number-pair? markup?)
3766   #:category align
3767   #:properties ((font-size 0))
3768   "
3769 @cindex translating text
3770 @cindex scaling text
3771
3772 Translate @var{arg} by @var{offset}, scaling the offset by the
3773 @code{font-size}.
3774
3775 @lilypond[verbatim,quote]
3776 \\markup {
3777   \\fontsize #5 {
3778     * \\translate #'(2 . 3) translate
3779     \\hspace #2
3780     * \\translate-scaled #'(2 . 3) translate-scaled
3781   }
3782 }
3783 @end lilypond"
3784   (let* ((factor (magstep font-size))
3785          (scaled (cons (* factor (car offset))
3786                        (* factor (cdr offset)))))
3787     (ly:stencil-translate (interpret-markup layout props arg)
3788                           scaled)))
3789
3790 (define-markup-command (raise layout props amount arg)
3791   (number? markup?)
3792   #:category align
3793   "
3794 @cindex raising text
3795
3796 Raise @var{arg} by the distance @var{amount}.
3797 A negative @var{amount} indicates lowering, see also @code{\\lower}.
3798
3799 The argument to @code{\\raise} is the vertical displacement amount,
3800 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
3801 raise objects in relation to their surrounding markups.
3802
3803 If the text object itself is positioned above or below the staff, then
3804 @code{\\raise} cannot be used to move it, since the mechanism that
3805 positions it next to the staff cancels any shift made with
3806 @code{\\raise}.  For vertical positioning, use the @code{padding}
3807 and/or @code{extra-offset} properties.
3808
3809 @lilypond[verbatim,quote]
3810 \\markup {
3811   C
3812   \\small
3813   \\bold
3814   \\raise #1.0
3815   9/7+
3816 }
3817 @end lilypond"
3818   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
3819
3820 (define-markup-command (fraction layout props arg1 arg2)
3821   (markup? markup?)
3822   #:category other
3823   #:properties ((font-size 0))
3824   "
3825 @cindex creating text fractions
3826
3827 Make a fraction of two markups.
3828 @lilypond[verbatim,quote]
3829 \\markup {
3830   π ≈
3831   \\fraction 355 113
3832 }
3833 @end lilypond"
3834   (let* ((m1 (interpret-markup layout props arg1))
3835          (m2 (interpret-markup layout props arg2))
3836          (factor (magstep font-size))
3837          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
3838          (padding (* factor 0.2))
3839          (baseline (* factor 0.6))
3840          (offset (* factor 0.75)))
3841     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
3842     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
3843     (let* ((x1 (ly:stencil-extent m1 X))
3844            (x2 (ly:stencil-extent m2 X))
3845            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
3846            ;; should stack mols separately, to maintain LINE on baseline
3847            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
3848       (set! stack
3849             (ly:stencil-aligned-to stack Y CENTER))
3850       (set! stack
3851             (ly:stencil-aligned-to stack X LEFT))
3852       ;; should have EX dimension
3853       ;; empirical anyway
3854       (ly:stencil-translate-axis stack offset Y))))
3855
3856 (define-markup-command (normal-size-super layout props arg)
3857   (markup?)
3858   #:category font
3859   #:properties ((baseline-skip))
3860   "
3861 @cindex setting superscript in standard font size
3862
3863 Set @var{arg} in superscript with a normal font size.
3864
3865 @lilypond[verbatim,quote]
3866 \\markup {
3867   default
3868   \\normal-size-super {
3869     superscript in standard size
3870   }
3871 }
3872 @end lilypond"
3873   (ly:stencil-translate-axis
3874    (interpret-markup layout props arg)
3875    (* 0.5 baseline-skip) Y))
3876
3877 (define-markup-command (super layout props arg)
3878   (markup?)
3879   #:category font
3880   #:properties ((font-size 0)
3881                 (baseline-skip))
3882   "
3883 @cindex superscript text
3884
3885 Set @var{arg} in superscript.
3886
3887 @lilypond[verbatim,quote]
3888 \\markup {
3889   E =
3890   \\concat {
3891     mc
3892     \\super
3893     2
3894   }
3895 }
3896 @end lilypond"
3897   (ly:stencil-translate-axis
3898    (interpret-markup
3899     layout
3900     (cons `((font-size . ,(- font-size 3))) props)
3901     arg)
3902    (* 0.5 baseline-skip)
3903    Y))
3904
3905 (define-markup-command (translate layout props offset arg)
3906   (number-pair? markup?)
3907   #:category align
3908   "
3909 @cindex translating text
3910
3911 Translate @var{arg} relative to its surroundings.  @var{offset}
3912 is a pair of numbers representing the displacement in the X and Y axis.
3913
3914 @lilypond[verbatim,quote]
3915 \\markup {
3916   *
3917   \\translate #'(2 . 3)
3918   \\line { translated two spaces right, three up }
3919 }
3920 @end lilypond"
3921   (ly:stencil-translate (interpret-markup layout props arg)
3922                         offset))
3923
3924 (define-markup-command (sub layout props arg)
3925   (markup?)
3926   #:category font
3927   #:properties ((font-size 0)
3928                 (baseline-skip))
3929   "
3930 @cindex subscript text
3931
3932 Set @var{arg} in subscript.
3933
3934 @lilypond[verbatim,quote]
3935 \\markup {
3936   \\concat {
3937     H
3938     \\sub {
3939       2
3940     }
3941     O
3942   }
3943 }
3944 @end lilypond"
3945   (ly:stencil-translate-axis
3946    (interpret-markup
3947     layout
3948     (cons `((font-size . ,(- font-size 3))) props)
3949     arg)
3950    (* -0.5 baseline-skip)
3951    Y))
3952
3953 (define-markup-command (normal-size-sub layout props arg)
3954   (markup?)
3955   #:category font
3956   #:properties ((baseline-skip))
3957   "
3958 @cindex setting subscript in standard font size
3959
3960 Set @var{arg} in subscript with a normal font size.
3961
3962 @lilypond[verbatim,quote]
3963 \\markup {
3964   default
3965   \\normal-size-sub {
3966     subscript in standard size
3967   }
3968 }
3969 @end lilypond"
3970   (ly:stencil-translate-axis
3971    (interpret-markup layout props arg)
3972    (* -0.5 baseline-skip)
3973    Y))
3974
3975 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3976 ;; brackets.
3977 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3978
3979 (define-markup-command (hbracket layout props arg)
3980   (markup?)
3981   #:category graphic
3982   "
3983 @cindex placing horizontal brackets around text
3984
3985 Draw horizontal brackets around @var{arg}.
3986
3987 @lilypond[verbatim,quote]
3988 \\markup {
3989   \\hbracket {
3990     \\line {
3991       one two three
3992     }
3993   }
3994 }
3995 @end lilypond"
3996   (let ((th 0.1) ;; todo: take from GROB.
3997         (m (interpret-markup layout props arg)))
3998     (bracketify-stencil m X th (* 2.5 th) th)))
3999
4000 (define-markup-command (bracket layout props arg)
4001   (markup?)
4002   #:category graphic
4003   "
4004 @cindex placing vertical brackets around text
4005
4006 Draw vertical brackets around @var{arg}.
4007
4008 @lilypond[verbatim,quote]
4009 \\markup {
4010   \\bracket {
4011     \\note #\"2.\" #UP
4012   }
4013 }
4014 @end lilypond"
4015   (let ((th 0.1) ;; todo: take from GROB.
4016         (m (interpret-markup layout props arg)))
4017     (bracketify-stencil m Y th (* 2.5 th) th)))
4018
4019 (define-markup-command (parenthesize layout props arg)
4020   (markup?)
4021   #:category graphic
4022   #:properties ((angularity 0)
4023                 (padding)
4024                 (size 1)
4025                 (thickness 1)
4026                 (width 0.25))
4027   "
4028 @cindex placing parentheses around text
4029
4030 Draw parentheses around @var{arg}.  This is useful for parenthesizing
4031 a column containing several lines of text.
4032
4033 @lilypond[verbatim,quote]
4034 \\markup {
4035   \\line {
4036     \\parenthesize {
4037       \\column {
4038         foo
4039         bar
4040       }
4041     }
4042     \\override #'(angularity . 2) {
4043       \\parenthesize {
4044         \\column {
4045           bah
4046           baz
4047         }
4048       }
4049     }
4050   }
4051 }
4052 @end lilypond"
4053   (let* ((markup (interpret-markup layout props arg))
4054          (scaled-width (* size width))
4055          (scaled-thickness
4056           (* (chain-assoc-get 'line-thickness props 0.1)
4057              thickness))
4058          (half-thickness
4059           (min (* size 0.5 scaled-thickness)
4060                (* (/ 4 3.0) scaled-width)))
4061          (padding (chain-assoc-get 'padding props half-thickness)))
4062     (parenthesize-stencil
4063      markup half-thickness scaled-width angularity padding)))
4064
4065
4066 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4067 ;; Delayed markup evaluation
4068 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4069
4070 (define-markup-command (page-ref layout props label gauge default)
4071   (symbol? markup? markup?)
4072   #:category other
4073   "
4074 @cindex referencing page numbers in text
4075
4076 Reference to a page number.  @var{label} is the label set on the referenced
4077 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
4078 the maximum width of the page number, and @var{default} the value to display
4079 when @var{label} is not found."
4080   (let* ((gauge-stencil (interpret-markup layout props gauge))
4081          (x-ext (ly:stencil-extent gauge-stencil X))
4082          (y-ext (ly:stencil-extent gauge-stencil Y)))
4083     (ly:make-stencil
4084      `(delay-stencil-evaluation
4085        ,(delay (ly:stencil-expr
4086                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
4087                        (page-number (if (list? table)
4088                                         (assoc-get label table)
4089                                         #f))
4090                        (page-markup (if page-number (format #f "~a" page-number) default))
4091                        (page-stencil (interpret-markup layout props page-markup))
4092                        (gap (- (interval-length x-ext)
4093                                (interval-length (ly:stencil-extent page-stencil X)))))
4094                   (interpret-markup layout props
4095                                     (markup #:hspace gap page-markup))))))
4096      x-ext
4097      y-ext)))
4098
4099 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4100 ;; scaling
4101 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4102
4103 (define-markup-command (scale layout props factor-pair arg)
4104   (number-pair? markup?)
4105   #:category graphic
4106   "
4107 @cindex scaling markup
4108 @cindex mirroring markup
4109
4110 Scale @var{arg}.  @var{factor-pair} is a pair of numbers
4111 representing the scaling-factor in the X and Y axes.
4112 Negative values may be used to produce mirror images.
4113
4114 @lilypond[verbatim,quote]
4115 \\markup {
4116   \\line {
4117     \\scale #'(2 . 1)
4118     stretched
4119     \\scale #'(1 . -1)
4120     mirrored
4121   }
4122 }
4123 @end lilypond"
4124   (let ((stil (interpret-markup layout props arg))
4125         (sx (car factor-pair))
4126         (sy (cdr factor-pair)))
4127     (ly:stencil-scale stil sx sy)))
4128
4129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4130 ;; Repeating
4131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4132
4133 (define-markup-command (pattern layout props count axis space pattern)
4134   (integer? integer? number? markup?)
4135   #:category other
4136   "
4137 Prints @var{count} times a @var{pattern} markup.
4138 Patterns are spaced apart by @var{space}.
4139 Patterns are distributed on @var{axis}.
4140
4141 @lilypond[verbatim, quote]
4142 \\markup \\column {
4143   \"Horizontally repeated :\"
4144   \\pattern #7 #X #2 \\flat
4145   \\null
4146   \"Vertically repeated :\"
4147   \\pattern #3 #Y #0.5 \\flat
4148 }
4149 @end lilypond"
4150   (let ((pattern-width (interval-length
4151                          (ly:stencil-extent (interpret-markup layout props pattern) X)))
4152         (new-props (prepend-alist-chain 'word-space 0 (prepend-alist-chain 'baseline-skip 0 props))))
4153     (let loop ((i (1- count)) (patterns (markup)))
4154       (if (zero? i)
4155           (interpret-markup
4156             layout
4157             new-props
4158             (if (= axis X)
4159                 (markup patterns pattern)
4160                 (markup #:column (patterns pattern))))
4161           (loop (1- i)
4162             (if (= axis X)
4163                 (markup patterns pattern #:hspace space)
4164                 (markup #:column (patterns pattern #:vspace space))))))))
4165
4166 (define-markup-command (fill-with-pattern layout props space dir pattern left right)
4167   (number? ly:dir? markup? markup? markup?)
4168   #:category align
4169   #:properties ((word-space)
4170                 (line-width))
4171   "
4172 Put @var{left} and @var{right} in a horizontal line of width @code{line-width}
4173 with a line of markups @var{pattern} in between.
4174 Patterns are spaced apart by @var{space}.
4175 Patterns are aligned to the @var{dir} markup.
4176
4177 @lilypond[verbatim, quote]
4178 \\markup \\column {
4179   \"right-aligned :\"
4180   \\fill-with-pattern #1 #RIGHT . first right
4181   \\fill-with-pattern #1 #RIGHT . second right
4182   \\null
4183   \"center-aligned :\"
4184   \\fill-with-pattern #1.5 #CENTER - left right
4185   \\null
4186   \"left-aligned :\"
4187   \\override #'(line-width . 50)
4188   \\fill-with-pattern #2 #LEFT : left first
4189   \\override #'(line-width . 50)
4190   \\fill-with-pattern #2 #LEFT : left second
4191 }
4192 @end lilypond"
4193   (let* ((pattern-x-extent (ly:stencil-extent (interpret-markup layout props pattern) X))
4194          (pattern-width (interval-length pattern-x-extent))
4195          (left-width (interval-length (ly:stencil-extent (interpret-markup layout props left) X)))
4196          (right-width (interval-length (ly:stencil-extent (interpret-markup layout props right) X)))
4197          (middle-width (max 0 (- line-width (+ (+ left-width right-width) (* word-space 2)))))
4198          (period (+ space pattern-width))
4199          (count (truncate (/ (- middle-width pattern-width) period)))
4200          (x-offset (+ (* (- (- middle-width (* count period)) pattern-width) (/ (1+ dir) 2)) (abs (car pattern-x-extent)))))
4201     (interpret-markup layout props
4202                       (markup left
4203                               #:with-dimensions (cons 0 middle-width) '(0 . 0)
4204                               #:translate (cons x-offset 0)
4205                               #:pattern (1+ count) X space pattern
4206                               right))))
4207
4208 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4209 ;; Replacements
4210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4211
4212 (define-markup-command (replace layout props replacements arg)
4213   (list? markup?)
4214   #:category font
4215   "
4216 Used to automatically replace a string by another in the markup @var{arg}.
4217 Each pair of the alist @var{replacements} specifies what should be replaced.
4218 The @code{key} is the string to be replaced by the @code{value} string.
4219
4220 @lilypond[verbatim, quote]
4221 \\markup \\replace #'((\"thx\" . \"Thanks!\")) thx
4222 @end lilypond"
4223   (interpret-markup
4224    layout
4225    (internal-add-text-replacements
4226     props
4227     replacements)
4228    (markup arg)))
4229
4230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4231 ;; Markup list commands
4232 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4233
4234 (define-public (space-lines baseline stils)
4235   (let space-stil ((stils stils)
4236                    (result (list)))
4237     (if (null? stils)
4238         (reverse! result)
4239         (let* ((stil (car stils))
4240                (dy-top (max (- (/ baseline 1.5)
4241                                (interval-bound (ly:stencil-extent stil Y) UP))
4242                             0.0))
4243                (dy-bottom (max (+ (/ baseline 3.0)
4244                                   (interval-bound (ly:stencil-extent stil Y) DOWN))
4245                                0.0))
4246                (new-stil (ly:make-stencil
4247                           (ly:stencil-expr stil)
4248                           (ly:stencil-extent stil X)
4249                           (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
4250                                    dy-bottom)
4251                                 (+ (interval-bound (ly:stencil-extent stil Y) UP)
4252                                    dy-top)))))
4253           (space-stil (cdr stils) (cons new-stil result))))))
4254
4255 (define-markup-list-command (justified-lines layout props args)
4256   (markup-list?)
4257   #:properties ((baseline-skip)
4258                 wordwrap-internal-markup-list)
4259   "
4260 @cindex justifying lines of text
4261
4262 Like @code{\\justify}, but return a list of lines instead of a single markup.
4263 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
4264 @var{X}@tie{}is the number of staff spaces."
4265   (space-lines baseline-skip
4266                (interpret-markup-list layout props
4267                                       (make-wordwrap-internal-markup-list #t args))))
4268
4269 (define-markup-list-command (wordwrap-lines layout props args)
4270   (markup-list?)
4271   #:properties ((baseline-skip)
4272                 wordwrap-internal-markup-list)
4273   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
4274 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
4275 where @var{X} is the number of staff spaces."
4276   (space-lines baseline-skip
4277                (interpret-markup-list layout props
4278                                       (make-wordwrap-internal-markup-list #f args))))
4279
4280 (define-markup-list-command (column-lines layout props args)
4281   (markup-list?)
4282   #:properties ((baseline-skip))
4283   "Like @code{\\column}, but return a list of lines instead of a single markup.
4284 @code{baseline-skip} determines the space between each markup in @var{args}."
4285   (space-lines baseline-skip
4286                (interpret-markup-list layout props args)))
4287
4288 (define-markup-list-command (override-lines layout props new-prop args)
4289   (pair? markup-list?)
4290   "Like @code{\\override}, for markup lists."
4291   (interpret-markup-list layout (cons (list new-prop) props) args))
4292
4293 (define-markup-list-command (map-markup-commands layout props compose args)
4294   (procedure? markup-list?)
4295   "This applies the function @var{compose} to every markup in
4296 @var{args} (including elements of markup list command calls) in order
4297 to produce a new markup list.  Since the return value from a markup
4298 list command call is not a markup list but rather a list of stencils,
4299 this requires passing those stencils off as the results of individual
4300 markup calls.  That way, the results should work out as long as no
4301 markups rely on side effects."
4302   (let ((key (make-symbol "key")))
4303     (catch
4304      key
4305      (lambda ()
4306        ;; if `compose' does not actually interpret its markup
4307        ;; argument, we still need to return a list of stencils,
4308        ;; created from the single returned stencil
4309        (list
4310         (interpret-markup layout props
4311                           (compose
4312                            (make-on-the-fly-markup
4313                             (lambda (layout props m)
4314                               ;; here all effects of `compose' on the
4315                               ;; properties should be visible, so we
4316                               ;; call interpret-markup-list at this
4317                               ;; point of time and harvest its
4318                               ;; stencils
4319                               (throw key
4320                                      (interpret-markup-list
4321                                       layout props args)))
4322                             (make-null-markup))))))
4323      (lambda (key stencils)
4324        (map
4325         (lambda (sten)
4326           (interpret-markup layout props
4327                             (compose (make-stencil-markup sten))))
4328         stencils)))))