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