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) (eq? 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) (eq? 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                                 ((eq? 3 (length x))
 927                                  (set-point (cons (second x)
 928                                                   (third x)))
 929                                  (drop x 1))
 930                                 ;; for curveto
 931                                 ((eq? 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.
 972
 973 @lilypond[verbatim,quote]
 974 \\markup {
 975   \\score {
 976     \\new PianoStaff <<
 977       \\new Staff \\relative c' {
 978         \\key f \\major
 979         \\time 3/4
 980         \\mark \\markup { Allegro }
 981         f2\\p( a4)
 982         c2( a4)
 983         bes2( g'4)
 984         f8( e) e4 r
 985       }
 986       \\new Staff \\relative c {
 987         \\clef bass
 988         \\key f \\major
 989         \\time 3/4
 990         f8( a c a c a
 991         f c' es c es c)
 992         f,( bes d bes d bes)
 993         f( g bes g bes g)
 994       }
 995     >>
 996     \\layout {
 997       indent = 0.0\\cm
 998       \\context {
 999         \\Score
1000         \\override RehearsalMark
1001           #'break-align-symbols = #'(time-signature key-signature)
1002         \\override RehearsalMark
1003           #'self-alignment-X = #LEFT
1004       }
1005       \\context {
1006         \\Staff
1007         \\override TimeSignature
1008           #'break-align-anchor-alignment = #LEFT
1009       }
1010     }
1011   }
1012 }
1013 @end lilypond"
1014   (let ((output (ly:score-embedded-format score layout)))
1015
1016     (if (ly:music-output? output)
1017         (stack-stencils Y DOWN baseline-skip
1018                         (map paper-system-stencil
1019                              (vector->list
1020                               (ly:paper-score-paper-systems output))))
1021         (begin
1022           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
1023           empty-stencil))))
1024
1025 (define-markup-command (null layout props)
1026   ()
1027   #:category other
1028   "
1029 @cindex creating empty text objects
1030
1031 An empty markup with extents of a single point.
1032
1033 @lilypond[verbatim,quote]
1034 \\markup {
1035   \\null
1036 }
1037 @end lilypond"
1038   point-stencil)
1039
1040 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1041 ;; basic formatting.
1042 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1043
1044 (define-markup-command (simple layout props str)
1045   (string?)
1046   #:category font
1047   "
1048 @cindex simple text strings
1049
1050 A simple text string; @code{\\markup @{ foo @}} is equivalent with
1051 @code{\\markup @{ \\simple #\"foo\" @}}.
1052
1053 Note: for creating standard text markup or defining new markup commands,
1054 the use of @code{\\simple} is unnecessary.
1055
1056 @lilypond[verbatim,quote]
1057 \\markup {
1058   \\simple #\"simple\"
1059   \\simple #\"text\"
1060   \\simple #\"strings\"
1061 }
1062 @end lilypond"
1063   (interpret-markup layout props str))
1064
1065 (define-markup-command (tied-lyric layout props str)
1066   (string?)
1067   #:category music
1068   #:properties ((word-space))
1069   "
1070 @cindex simple text strings with tie characters
1071
1072 Like simple-markup, but use tie characters for @q{~} tilde symbols.
1073
1074 @lilypond[verbatim,quote]
1075 \\markup \\column {
1076   \\tied-lyric #\"Siam navi~all'onde~algenti Lasciate~in abbandono\"
1077   \\tied-lyric #\"Impetuosi venti I nostri~affetti sono\"
1078   \\tied-lyric #\"Ogni diletto~e scoglio Tutta la vita~e~un mar.\"
1079 }
1080 @end lilypond"
1081   (define (replace-ties tie str)
1082     (if (string-contains str "~")
1083         (let*
1084           ((half-space (/ word-space 2))
1085            (parts (string-split str #\~))
1086            (tie-str (markup #:hspace half-space
1087                             #:musicglyph tie
1088                             #:hspace half-space))
1089            (joined  (list-join parts tie-str)))
1090           (make-concat-markup joined))
1091         str))
1092
1093   (define short-tie-regexp (make-regexp "~[^.]~"))
1094   (define (match-short str) (regexp-exec short-tie-regexp str))
1095
1096   (define (replace-short str mkp)
1097     (let ((match (match-short str)))
1098       (if (not match)
1099           (make-concat-markup (list
1100             mkp
1101             (replace-ties "ties.lyric.default" str)))
1102           (let ((new-str (match:suffix match))
1103                 (new-mkp (make-concat-markup (list
1104                           mkp
1105                           (replace-ties "ties.lyric.default"
1106                                         (match:prefix match))
1107                           (replace-ties "ties.lyric.short"
1108                                         (match:substring match))))))
1109               (replace-short new-str new-mkp)))))
1110
1111   (interpret-markup layout
1112                     props
1113                     (replace-short str (markup))))
1114
1115 (define-public empty-markup
1116   (make-simple-markup ""))
1117
1118 ;; helper for justifying lines.
1119 (define (get-fill-space word-count line-width word-space text-widths)
1120   "Calculate the necessary paddings between each two adjacent texts.
1121   The lengths of all texts are stored in @var{text-widths}.
1122   The normal formula for the padding between texts a and b is:
1123   padding = line-width/(word-count - 1) - (length(a) + length(b))/2
1124   The first and last padding have to be calculated specially using the
1125   whole length of the first or last text.
1126   All paddings are checked to be at least word-space, to ensure that
1127   no texts collide.
1128   Return a list of paddings."
1129   (cond
1130    ((null? text-widths) '())
1131
1132    ;; special case first padding
1133    ((= (length text-widths) word-count)
1134     (cons
1135      (- (- (/ line-width (1- word-count)) (car text-widths))
1136         (/ (car (cdr text-widths)) 2))
1137      (get-fill-space word-count line-width word-space (cdr text-widths))))
1138    ;; special case last padding
1139    ((= (length text-widths) 2)
1140     (list (- (/ line-width (1- word-count))
1141              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
1142    (else
1143     (let ((default-padding
1144             (- (/ line-width (1- word-count))
1145                (/ (+ (car text-widths) (car (cdr text-widths))) 2))))
1146       (cons
1147        (if (> word-space default-padding)
1148            word-space
1149            default-padding)
1150        (get-fill-space word-count line-width word-space (cdr text-widths)))))))
1151
1152 (define-markup-command (fill-line layout props args)
1153   (markup-list?)
1154   #:category align
1155   #:properties ((text-direction RIGHT)
1156                 (word-space 0.6)
1157                 (line-width #f))
1158   "Put @var{markups} in a horizontal line of width @var{line-width}.
1159 The markups are spaced or flushed to fill the entire line.
1160 If there are no arguments, return an empty stencil.
1161
1162 @lilypond[verbatim,quote]
1163 \\markup {
1164   \\column {
1165     \\fill-line {
1166       Words evenly spaced across the page
1167     }
1168     \\null
1169     \\fill-line {
1170       \\line { Text markups }
1171       \\line {
1172         \\italic { evenly spaced }
1173       }
1174       \\line { across the page }
1175     }
1176   }
1177 }
1178 @end lilypond"
1179   (let* ((orig-stencils (interpret-markup-list layout props args))
1180          (stencils
1181           (map (lambda (stc)
1182                  (if (ly:stencil-empty? stc)
1183                      point-stencil
1184                      stc)) orig-stencils))
1185          (text-widths
1186           (map (lambda (stc)
1187                  (if (ly:stencil-empty? stc)
1188                      0.0
1189                      (interval-length (ly:stencil-extent stc X))))
1190                stencils))
1191          (text-width (apply + text-widths))
1192          (word-count (length stencils))
1193          (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
1194          (fill-space
1195           (cond
1196            ((= word-count 1)
1197             (list
1198              (/ (- line-width text-width) 2)
1199              (/ (- line-width text-width) 2)))
1200            ((= word-count 2)
1201             (list
1202              (- line-width text-width)))
1203            (else
1204             (get-fill-space word-count line-width word-space text-widths))))
1205
1206          (line-contents (if (= word-count 1)
1207                             (list
1208                              point-stencil
1209                              (car stencils)
1210                              point-stencil)
1211                             stencils)))
1212
1213     (if (null? (remove ly:stencil-empty? orig-stencils))
1214         empty-stencil
1215         (begin
1216           (if (= text-direction LEFT)
1217               (set! line-contents (reverse line-contents)))
1218           (set! line-contents
1219                 (stack-stencils-padding-list
1220                  X RIGHT fill-space line-contents))
1221           (if (> word-count 1)
1222               ;; shift s.t. stencils align on the left edge, even if
1223               ;; first stencil had negative X-extent (e.g. center-column)
1224               ;; (if word-count = 1, X-extents are already normalized in
1225               ;; the definition of line-contents)
1226               (set! line-contents
1227                     (ly:stencil-translate-axis
1228                      line-contents
1229                      (- (car (ly:stencil-extent (car stencils) X)))
1230                      X)))
1231           line-contents))))
1232
1233 (define-markup-command (line layout props args)
1234   (markup-list?)
1235   #:category align
1236   #:properties ((word-space)
1237                 (text-direction RIGHT))
1238   "Put @var{args} in a horizontal line.  The property @code{word-space}
1239 determines the space between markups in @var{args}.
1240
1241 @lilypond[verbatim,quote]
1242 \\markup {
1243   \\line {
1244     one two three
1245   }
1246 }
1247 @end lilypond"
1248   (let ((stencils (interpret-markup-list layout props args)))
1249     (if (= text-direction LEFT)
1250         (set! stencils (reverse stencils)))
1251     (stack-stencil-line
1252      word-space
1253      (remove ly:stencil-empty? stencils))))
1254
1255 (define-markup-command (concat layout props args)
1256   (markup-list?)
1257   #:category align
1258   "
1259 @cindex concatenating text
1260 @cindex ligatures in text
1261
1262 Concatenate @var{args} in a horizontal line, without spaces in between.
1263 Strings and simple markups are concatenated on the input level, allowing
1264 ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
1265 equivalent to @code{\"fi\"}.
1266
1267 @lilypond[verbatim,quote]
1268 \\markup {
1269   \\concat {
1270     one
1271     two
1272     three
1273   }
1274 }
1275 @end lilypond"
1276   (define (concat-string-args arg-list)
1277     (fold-right (lambda (arg result-list)
1278                   (let ((result (if (pair? result-list)
1279                                     (car result-list)
1280                                   '())))
1281                     (if (and (pair? arg) (eqv? (car arg) simple-markup))
1282                       (set! arg (cadr arg)))
1283                     (if (and (string? result) (string? arg))
1284                         (cons (string-append arg result) (cdr result-list))
1285                       (cons arg result-list))))
1286                 '()
1287                 arg-list))
1288
1289   (interpret-markup layout
1290                     (prepend-alist-chain 'word-space 0 props)
1291                     (make-line-markup (if (markup-command-list? args)
1292                                           args
1293                                           (concat-string-args args)))))
1294
1295 (define (wordwrap-stencils stencils
1296                            justify base-space line-width text-dir)
1297   "Perform simple wordwrap, return stencil of each line."
1298   (define space (if justify
1299                     ;; justify only stretches lines.
1300                     (* 0.7 base-space)
1301                     base-space))
1302   (define (take-list width space stencils
1303                      accumulator accumulated-width)
1304     "Return (head-list . tail) pair, with head-list fitting into width"
1305     (if (null? stencils)
1306         (cons accumulator stencils)
1307         (let* ((first (car stencils))
1308                (first-wid (cdr (ly:stencil-extent (car stencils) X)))
1309                (newwid (+ space first-wid accumulated-width)))
1310           (if (or (null? accumulator)
1311                   (< newwid width))
1312               (take-list width space
1313                          (cdr stencils)
1314                          (cons first accumulator)
1315                          newwid)
1316               (cons accumulator stencils)))))
1317   (let loop ((lines '())
1318              (todo stencils))
1319     (let* ((line-break (take-list line-width space todo
1320                                   '() 0.0))
1321            (line-stencils (car line-break))
1322            (space-left (- line-width
1323                           (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
1324                                         line-stencils))))
1325            (line-word-space (cond ((not justify) space)
1326                                   ;; don't stretch last line of paragraph.
1327                                   ;; hmmm . bug - will overstretch the last line in some case.
1328                                   ((null? (cdr line-break))
1329                                    base-space)
1330                                   ((null? line-stencils) 0.0)
1331                                   ((null? (cdr line-stencils)) 0.0)
1332                                   (else (/ space-left (1- (length line-stencils))))))
1333            (line (stack-stencil-line line-word-space
1334                                      (if (= text-dir RIGHT)
1335                                          (reverse line-stencils)
1336                                          line-stencils))))
1337       (if (pair? (cdr line-break))
1338           (loop (cons line lines)
1339                 (cdr line-break))
1340           (begin
1341             (if (= text-dir LEFT)
1342                 (set! line
1343                       (ly:stencil-translate-axis
1344                        line
1345                        (- line-width (interval-end (ly:stencil-extent line X)))
1346                        X)))
1347             (reverse (cons line lines)))))))
1348
1349 (define-markup-list-command (wordwrap-internal layout props justify args)
1350   (boolean? markup-list?)
1351   #:properties ((line-width #f)
1352                 (word-space)
1353                 (text-direction RIGHT))
1354   "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
1355   (wordwrap-stencils (remove ly:stencil-empty?
1356                              (interpret-markup-list layout props args))
1357                      justify
1358                      word-space
1359                      (or line-width
1360                          (ly:output-def-lookup layout 'line-width))
1361                      text-direction))
1362
1363 (define-markup-command (justify layout props args)
1364   (markup-list?)
1365   #:category align
1366   #:properties ((baseline-skip)
1367                 wordwrap-internal-markup-list)
1368   "
1369 @cindex justifying text
1370
1371 Like @code{\\wordwrap}, but with lines stretched to justify the margins.
1372 Use @code{\\override #'(line-width . @var{X})} to set the line width;
1373 @var{X}@tie{}is the number of staff spaces.
1374
1375 @lilypond[verbatim,quote]
1376 \\markup {
1377   \\justify {
1378     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
1379     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1380     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1381     laboris nisi ut aliquip ex ea commodo consequat.
1382   }
1383 }
1384 @end lilypond"
1385   (stack-lines DOWN 0.0 baseline-skip
1386                (wordwrap-internal-markup-list layout props #t args)))
1387
1388 (define-markup-command (wordwrap layout props args)
1389   (markup-list?)
1390   #:category align
1391   #:properties ((baseline-skip)
1392                 wordwrap-internal-markup-list)
1393   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
1394 the line width, where @var{X} is the number of staff spaces.
1395
1396 @lilypond[verbatim,quote]
1397 \\markup {
1398   \\wordwrap {
1399     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
1400     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1401     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1402     laboris nisi ut aliquip ex ea commodo consequat.
1403   }
1404 }
1405 @end lilypond"
1406   (stack-lines DOWN 0.0 baseline-skip
1407                (wordwrap-internal-markup-list layout props #f args)))
1408
1409 (define-markup-list-command (wordwrap-string-internal layout props justify arg)
1410   (boolean? string?)
1411   #:properties ((line-width)
1412                 (word-space)
1413                 (text-direction RIGHT))
1414   "Internal markup list command used to define @code{\\justify-string} and
1415 @code{\\wordwrap-string}."
1416   (let* ((para-strings (regexp-split
1417                         (string-regexp-substitute
1418                          "\r" "\n"
1419                          (string-regexp-substitute "\r\n" "\n" arg))
1420                         "\n[ \t\n]*\n[ \t\n]*"))
1421          (list-para-words (map (lambda (str)
1422                                  (regexp-split str "[ \t\n]+"))
1423                                para-strings))
1424          (para-lines (map (lambda (words)
1425                             (let* ((stencils
1426                                     (remove ly:stencil-empty?
1427                                             (map (lambda (x)
1428                                                    (interpret-markup layout props x))
1429                                                  words))))
1430                               (wordwrap-stencils stencils
1431                                                  justify word-space
1432                                                  line-width text-direction)))
1433                           list-para-words)))
1434     (apply append para-lines)))
1435
1436 (define-markup-command (wordwrap-string layout props arg)
1437   (string?)
1438   #:category align
1439   #:properties ((baseline-skip)
1440                 wordwrap-string-internal-markup-list)
1441   "Wordwrap a string.  Paragraphs may be separated with double newlines.
1442
1443 @lilypond[verbatim,quote]
1444 \\markup {
1445   \\override #'(line-width . 40)
1446   \\wordwrap-string #\"Lorem ipsum dolor sit amet, consectetur
1447       adipisicing elit, sed do eiusmod tempor incididunt ut labore
1448       et dolore magna aliqua.
1449
1450
1451       Ut enim ad minim veniam, quis nostrud exercitation ullamco
1452       laboris nisi ut aliquip ex ea commodo consequat.
1453
1454
1455       Excepteur sint occaecat cupidatat non proident, sunt in culpa
1456       qui officia deserunt mollit anim id est laborum\"
1457 }
1458 @end lilypond"
1459   (stack-lines DOWN 0.0 baseline-skip
1460                (wordwrap-string-internal-markup-list layout props #f arg)))
1461
1462 (define-markup-command (justify-string layout props arg)
1463   (string?)
1464   #:category align
1465   #:properties ((baseline-skip)
1466                 wordwrap-string-internal-markup-list)
1467   "Justify a string.  Paragraphs may be separated with double newlines
1468
1469 @lilypond[verbatim,quote]
1470 \\markup {
1471   \\override #'(line-width . 40)
1472   \\justify-string #\"Lorem ipsum dolor sit amet, consectetur
1473       adipisicing elit, sed do eiusmod tempor incididunt ut labore
1474       et dolore magna aliqua.
1475
1476
1477       Ut enim ad minim veniam, quis nostrud exercitation ullamco
1478       laboris nisi ut aliquip ex ea commodo consequat.
1479
1480
1481       Excepteur sint occaecat cupidatat non proident, sunt in culpa
1482       qui officia deserunt mollit anim id est laborum\"
1483 }
1484 @end lilypond"
1485   (stack-lines DOWN 0.0 baseline-skip
1486                (wordwrap-string-internal-markup-list layout props #t arg)))
1487
1488 (define-markup-command (wordwrap-field layout props symbol)
1489   (symbol?)
1490   #:category align
1491   "Wordwrap the data which has been assigned to @var{symbol}.
1492
1493 @lilypond[verbatim,quote]
1494 \\header {
1495   title = \"My title\"
1496   myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
1497     elit, sed do eiusmod tempor incididunt ut labore et dolore
1498     magna aliqua.  Ut enim ad minim veniam, quis nostrud
1499     exercitation ullamco laboris nisi ut aliquip ex ea commodo
1500     consequat.\"
1501 }
1502
1503 \\paper {
1504   bookTitleMarkup = \\markup {
1505     \\column {
1506       \\fill-line { \\fromproperty #'header:title }
1507       \\null
1508       \\wordwrap-field #'header:myText
1509     }
1510   }
1511 }
1512
1513 \\markup {
1514   \\null
1515 }
1516 @end lilypond"
1517   (let* ((m (chain-assoc-get symbol props)))
1518     (if (string? m)
1519         (wordwrap-string-markup layout props m)
1520         empty-stencil)))
1521
1522 (define-markup-command (justify-field layout props symbol)
1523   (symbol?)
1524   #:category align
1525   "Justify the data which has been assigned to @var{symbol}.
1526
1527 @lilypond[verbatim,quote]
1528 \\header {
1529   title = \"My title\"
1530   myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
1531     elit, sed do eiusmod tempor incididunt ut labore et dolore magna
1532     aliqua.  Ut enim ad minim veniam, quis nostrud exercitation ullamco
1533     laboris nisi ut aliquip ex ea commodo consequat.\"
1534 }
1535
1536 \\paper {
1537   bookTitleMarkup = \\markup {
1538     \\column {
1539       \\fill-line { \\fromproperty #'header:title }
1540       \\null
1541       \\justify-field #'header:myText
1542     }
1543   }
1544 }
1545
1546 \\markup {
1547   \\null
1548 }
1549 @end lilypond"
1550   (let* ((m (chain-assoc-get symbol props)))
1551     (if (string? m)
1552         (justify-string-markup layout props m)
1553         empty-stencil)))
1554
1555 (define-markup-command (combine layout props arg1 arg2)
1556   (markup? markup?)
1557   #:category align
1558   "
1559 @cindex merging text
1560
1561 Print two markups on top of each other.
1562
1563 Note: @code{\\combine} cannot take a list of markups enclosed in
1564 curly braces as an argument; the follow example will not compile:
1565
1566 @example
1567 \\combine @{ a list @}
1568 @end example
1569
1570 @lilypond[verbatim,quote]
1571 \\markup {
1572   \\fontsize #5
1573   \\override #'(thickness . 2)
1574   \\combine
1575     \\draw-line #'(0 . 4)
1576     \\arrow-head #Y #DOWN ##f
1577 }
1578 @end lilypond"
1579   (let* ((s1 (interpret-markup layout props arg1))
1580          (s2 (interpret-markup layout props arg2)))
1581     (ly:stencil-add s1 s2)))
1582
1583 ;;
1584 ;; TODO: should extract baseline-skip from each argument somehow..
1585 ;;
1586 (define-markup-command (column layout props args)
1587   (markup-list?)
1588   #:category align
1589   #:properties ((baseline-skip))
1590   "
1591 @cindex stacking text in a column
1592
1593 Stack the markups in @var{args} vertically.  The property
1594 @code{baseline-skip} determines the space between markups
1595 in @var{args}.
1596
1597 @lilypond[verbatim,quote]
1598 \\markup {
1599   \\column {
1600     one
1601     two
1602     three
1603   }
1604 }
1605 @end lilypond"
1606   (let ((arg-stencils (interpret-markup-list layout props args)))
1607     (stack-lines -1 0.0 baseline-skip
1608                  (remove ly:stencil-empty? arg-stencils))))
1609
1610 (define-markup-command (dir-column layout props args)
1611   (markup-list?)
1612   #:category align
1613   #:properties ((direction)
1614                 (baseline-skip))
1615   "
1616 @cindex changing direction of text columns
1617
1618 Make a column of @var{args}, going up or down, depending on the
1619 setting of the @code{direction} layout property.
1620
1621 @lilypond[verbatim,quote]
1622 \\markup {
1623   \\override #`(direction . ,UP) {
1624     \\dir-column {
1625       going up
1626     }
1627   }
1628   \\hspace #1
1629   \\dir-column {
1630     going down
1631   }
1632   \\hspace #1
1633   \\override #'(direction . 1) {
1634     \\dir-column {
1635       going up
1636     }
1637   }
1638 }
1639 @end lilypond"
1640   (stack-lines (if (number? direction) direction -1)
1641                0.0
1642                baseline-skip
1643                (interpret-markup-list layout props args)))
1644
1645 (define (general-column align-dir baseline mols)
1646   "Stack @var{mols} vertically, aligned to  @var{align-dir} horizontally."
1647
1648   (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols))
1649          (stacked-stencil (stack-lines -1 0.0 baseline aligned-mols))
1650          (stacked-extent (ly:stencil-extent stacked-stencil X)))
1651     (ly:stencil-translate-axis stacked-stencil (- (car stacked-extent)) X )))
1652
1653 (define-markup-command (center-column layout props args)
1654   (markup-list?)
1655   #:category align
1656   #:properties ((baseline-skip))
1657   "
1658 @cindex centering a column of text
1659
1660 Put @code{args} in a centered column.
1661
1662 @lilypond[verbatim,quote]
1663 \\markup {
1664   \\center-column {
1665     one
1666     two
1667     three
1668   }
1669 }
1670 @end lilypond"
1671   (general-column CENTER baseline-skip (interpret-markup-list layout props args)))
1672
1673 (define-markup-command (left-column layout props args)
1674   (markup-list?)
1675   #:category align
1676   #:properties ((baseline-skip))
1677  "
1678 @cindex text columns, left-aligned
1679
1680 Put @code{args} in a left-aligned column.
1681
1682 @lilypond[verbatim,quote]
1683 \\markup {
1684   \\left-column {
1685     one
1686     two
1687     three
1688   }
1689 }
1690 @end lilypond"
1691   (general-column LEFT baseline-skip (interpret-markup-list layout props args)))
1692
1693 (define-markup-command (right-column layout props args)
1694   (markup-list?)
1695   #:category align
1696   #:properties ((baseline-skip))
1697  "
1698 @cindex text columns, right-aligned
1699
1700 Put @code{args} in a right-aligned column.
1701
1702 @lilypond[verbatim,quote]
1703 \\markup {
1704   \\right-column {
1705     one
1706     two
1707     three
1708   }
1709 }
1710 @end lilypond"
1711   (general-column RIGHT baseline-skip (interpret-markup-list layout props args)))
1712
1713 (define-markup-command (vcenter layout props arg)
1714   (markup?)
1715   #:category align
1716   "
1717 @cindex vertically centering text
1718
1719 Align @code{arg} to its Y@tie{}center.
1720
1721 @lilypond[verbatim,quote]
1722 \\markup {
1723   one
1724   \\vcenter
1725   two
1726   three
1727 }
1728 @end lilypond"
1729   (let* ((mol (interpret-markup layout props arg)))
1730     (ly:stencil-aligned-to mol Y CENTER)))
1731
1732 (define-markup-command (center-align layout props arg)
1733   (markup?)
1734   #:category align
1735   "
1736 @cindex horizontally centering text
1737
1738 Align @code{arg} to its X@tie{}center.
1739
1740 @lilypond[verbatim,quote]
1741 \\markup {
1742   \\column {
1743     one
1744     \\center-align
1745     two
1746     three
1747   }
1748 }
1749 @end lilypond"
1750   (let* ((mol (interpret-markup layout props arg)))
1751     (ly:stencil-aligned-to mol X CENTER)))
1752
1753 (define-markup-command (right-align layout props arg)
1754   (markup?)
1755   #:category align
1756   "
1757 @cindex right aligning text
1758
1759 Align @var{arg} on its right edge.
1760
1761 @lilypond[verbatim,quote]
1762 \\markup {
1763   \\column {
1764     one
1765     \\right-align
1766     two
1767     three
1768   }
1769 }
1770 @end lilypond"
1771   (let* ((m (interpret-markup layout props arg)))
1772     (ly:stencil-aligned-to m X RIGHT)))
1773
1774 (define-markup-command (left-align layout props arg)
1775   (markup?)
1776   #:category align
1777   "
1778 @cindex left aligning text
1779
1780 Align @var{arg} on its left edge.
1781
1782 @lilypond[verbatim,quote]
1783 \\markup {
1784   \\column {
1785     one
1786     \\left-align
1787     two
1788     three
1789   }
1790 }
1791 @end lilypond"
1792   (let* ((m (interpret-markup layout props arg)))
1793     (ly:stencil-aligned-to m X LEFT)))
1794
1795 (define-markup-command (general-align layout props axis dir arg)
1796   (integer? number? markup?)
1797   #:category align
1798   "
1799 @cindex controlling general text alignment
1800
1801 Align @var{arg} in @var{axis} direction to the @var{dir} side.
1802
1803 @lilypond[verbatim,quote]
1804 \\markup {
1805   \\column {
1806     one
1807     \\general-align #X #LEFT
1808     two
1809     three
1810     \\null
1811     one
1812     \\general-align #X #CENTER
1813     two
1814     three
1815     \\null
1816     \\line {
1817       one
1818       \\general-align #Y #UP
1819       two
1820       three
1821     }
1822     \\null
1823     \\line {
1824       one
1825       \\general-align #Y #3.2
1826       two
1827       three
1828     }
1829   }
1830 }
1831 @end lilypond"
1832   (let* ((m (interpret-markup layout props arg)))
1833     (ly:stencil-aligned-to m axis dir)))
1834
1835 (define-markup-command (halign layout props dir arg)
1836   (number? markup?)
1837   #:category align
1838   "
1839 @cindex setting horizontal text alignment
1840
1841 Set horizontal alignment.  If @var{dir} is @w{@code{-1}}, then it is
1842 left-aligned, while @code{+1} is right.  Values in between interpolate
1843 alignment accordingly.
1844
1845 @lilypond[verbatim,quote]
1846 \\markup {
1847   \\column {
1848     one
1849     \\halign #LEFT
1850     two
1851     three
1852     \\null
1853     one
1854     \\halign #CENTER
1855     two
1856     three
1857     \\null
1858     one
1859     \\halign #RIGHT
1860     two
1861     three
1862     \\null
1863     one
1864     \\halign #-5
1865     two
1866     three
1867   }
1868 }
1869 @end lilypond"
1870   (let* ((m (interpret-markup layout props arg)))
1871     (ly:stencil-aligned-to m X dir)))
1872
1873 (define-markup-command (with-dimensions layout props x y arg)
1874   (number-pair? number-pair? markup?)
1875   #:category other
1876   "
1877 @cindex setting extent of text objects
1878
1879 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
1880   (let* ((m (interpret-markup layout props arg)))
1881     (ly:make-stencil (ly:stencil-expr m) x y)))
1882
1883 (define-markup-command (pad-around layout props amount arg)
1884   (number? markup?)
1885   #:category align
1886   "Add padding @var{amount} all around @var{arg}.
1887
1888 @lilypond[verbatim,quote]
1889 \\markup {
1890   \\box {
1891     default
1892   }
1893   \\hspace #2
1894   \\box {
1895     \\pad-around #0.5 {
1896       padded
1897     }
1898   }
1899 }
1900 @end lilypond"
1901   (let* ((m (interpret-markup layout props arg))
1902          (x (ly:stencil-extent m X))
1903          (y (ly:stencil-extent m Y)))
1904     (ly:make-stencil (ly:stencil-expr m)
1905                      (interval-widen x amount)
1906                      (interval-widen y amount))))
1907
1908 (define-markup-command (pad-x layout props amount arg)
1909   (number? markup?)
1910   #:category align
1911   "
1912 @cindex padding text horizontally
1913
1914 Add padding @var{amount} around @var{arg} in the X@tie{}direction.
1915
1916 @lilypond[verbatim,quote]
1917 \\markup {
1918   \\box {
1919     default
1920   }
1921   \\hspace #4
1922   \\box {
1923     \\pad-x #2 {
1924       padded
1925     }
1926   }
1927 }
1928 @end lilypond"
1929   (let* ((m (interpret-markup layout props arg))
1930          (x (ly:stencil-extent m X))
1931          (y (ly:stencil-extent m Y)))
1932     (ly:make-stencil (ly:stencil-expr m)
1933                      (interval-widen x amount)
1934                      y)))
1935
1936 (define-markup-command (put-adjacent layout props axis dir arg1 arg2)
1937   (integer? ly:dir? markup? markup?)
1938   #:category align
1939   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1940   (let ((m1 (interpret-markup layout props arg1))
1941         (m2 (interpret-markup layout props arg2)))
1942     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1943
1944 (define-markup-command (transparent layout props arg)
1945   (markup?)
1946   #:category other
1947   "Make @var{arg} transparent.
1948
1949 @lilypond[verbatim,quote]
1950 \\markup {
1951   \\transparent {
1952     invisible text
1953   }
1954 }
1955 @end lilypond"
1956   (let* ((m (interpret-markup layout props arg))
1957          (x (ly:stencil-extent m X))
1958          (y (ly:stencil-extent m Y)))
1959     (ly:make-stencil "" x y)))
1960
1961 (define-markup-command (pad-to-box layout props x-ext y-ext arg)
1962   (number-pair? number-pair? markup?)
1963   #:category align
1964   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space.
1965
1966 @lilypond[verbatim,quote]
1967 \\markup {
1968   \\box {
1969     default
1970   }
1971   \\hspace #4
1972   \\box {
1973     \\pad-to-box #'(0 . 10) #'(0 . 3) {
1974       padded
1975     }
1976   }
1977 }
1978 @end lilypond"
1979   (let* ((m (interpret-markup layout props arg))
1980          (x (ly:stencil-extent m X))
1981          (y (ly:stencil-extent m Y)))
1982     (ly:make-stencil (ly:stencil-expr m)
1983                      (interval-union x-ext x)
1984                      (interval-union y-ext y))))
1985
1986 (define-markup-command (hcenter-in layout props length arg)
1987   (number? markup?)
1988   #:category align
1989   "Center @var{arg} horizontally within a box of extending
1990 @var{length}/2 to the left and right.
1991
1992 @lilypond[quote,verbatim]
1993 \\new StaffGroup <<
1994   \\new Staff {
1995     \\set Staff.instrumentName = \\markup {
1996       \\hcenter-in #12
1997       Oboe
1998     }
1999     c''1
2000   }
2001   \\new Staff {
2002     \\set Staff.instrumentName = \\markup {
2003       \\hcenter-in #12
2004       Bassoon
2005     }
2006     \\clef tenor
2007     c'1
2008   }
2009 >>
2010 @end lilypond"
2011   (interpret-markup layout props
2012                     (make-pad-to-box-markup
2013                      (cons (/ length -2) (/ length 2))
2014                      '(0 . 0)
2015                      (make-center-align-markup arg))))
2016
2017 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2018 ;; property
2019 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2020
2021 (define-markup-command (property-recursive layout props symbol)
2022   (symbol?)
2023   #:category other
2024   "Print out a warning when a header field markup contains some recursive
2025 markup definition."
2026   (ly:warning "Recursive definition of property ~a detected!" symbol)
2027   empty-stencil)
2028
2029 (define-markup-command (fromproperty layout props symbol)
2030   (symbol?)
2031   #:category other
2032   "Read the @var{symbol} from property settings, and produce a stencil
2033 from the markup contained within.  If @var{symbol} is not defined, it
2034 returns an empty markup.
2035
2036 @lilypond[verbatim,quote]
2037 \\header {
2038   myTitle = \"myTitle\"
2039   title = \\markup {
2040     from
2041     \\italic
2042     \\fromproperty #'header:myTitle
2043   }
2044 }
2045 \\markup {
2046   \\null
2047 }
2048 @end lilypond"
2049   (let ((m (chain-assoc-get symbol props)))
2050     (if (markup? m)
2051         ;; prevent infinite loops by clearing the interpreted property:
2052         (interpret-markup layout (cons (list (cons symbol `(,property-recursive-markup ,symbol))) props) m)
2053         empty-stencil)))
2054
2055 (define-markup-command (on-the-fly layout props procedure arg)
2056   (procedure? markup?)
2057   #:category other
2058   "Apply the @var{procedure} markup command to @var{arg}.
2059 @var{procedure} should take a single argument."
2060   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
2061     (set-object-property! anonymous-with-signature
2062                           'markup-signature
2063                           (list markup?))
2064     (interpret-markup layout props (list anonymous-with-signature arg))))
2065
2066 (define-markup-command (footnote layout props mkup note)
2067   (markup? markup?)
2068   #:category other
2069   "Have footnote @var{note} act as an annotation to the markup @var{mkup}.
2070
2071 @lilypond[verbatim,quote]
2072 \\markup {
2073   \\auto-footnote a b
2074   \\override #'(padding . 0.2)
2075   \\auto-footnote c d
2076 }
2077 @end lilypond
2078 The footnote will not be annotated automatically."
2079   (ly:stencil-combine-at-edge
2080     (interpret-markup layout props mkup)
2081     X
2082     RIGHT
2083     (ly:make-stencil
2084       `(footnote (gensym "footnote") #f ,(interpret-markup layout props note))
2085       '(0 . 0)
2086       '(0 . 0))
2087     0.0))
2088
2089 (define-markup-command (auto-footnote layout props mkup note)
2090   (markup? markup?)
2091   #:category other
2092   #:properties ((raise 0.5)
2093                 (padding 0.0))
2094   "Have footnote @var{note} act as an annotation to the markup @var{mkup}.
2095
2096 @lilypond[verbatim,quote]
2097 \\markup {
2098   \\auto-footnote a b
2099   \\override #'(padding . 0.2)
2100   \\auto-footnote c d
2101 }
2102 @end lilypond
2103 The footnote will be annotated automatically."
2104   (let* ((markup-stencil (interpret-markup layout props mkup))
2105          (footnote-hash (gensym "footnote"))
2106          (stencil-seed 0)
2107          (gauge-stencil (interpret-markup
2108                            layout
2109                            props
2110                            ((ly:output-def-lookup
2111                                layout
2112                                'footnote-numbering-function)
2113                               stencil-seed)))
2114          (x-ext (ly:stencil-extent gauge-stencil X))
2115          (y-ext (ly:stencil-extent gauge-stencil Y))
2116          (footnote-number
2117            `(delay-stencil-evaluation
2118               ,(delay
2119                 (ly:stencil-expr
2120                   (let* ((table
2121                           (ly:output-def-lookup layout
2122                                                 'number-footnote-table))
2123                          (footnote-stencil (if (list? table)
2124                                                (assoc-get footnote-hash
2125                                                           table)
2126                                                empty-stencil))
2127                          (footnote-stencil (if (ly:stencil? footnote-stencil)
2128                                                footnote-stencil
2129                                                (begin
2130                                                  (ly:programming-error
2131 "Cannot find correct footnote for a markup object.")
2132                                                  empty-stencil)))
2133                          (gap (- (interval-length x-ext)
2134                                  (interval-length
2135                                    (ly:stencil-extent footnote-stencil X))))
2136                          (y-trans (- (+ (cdr y-ext)
2137                                         raise)
2138                                      (cdr (ly:stencil-extent footnote-stencil
2139                                                              Y)))))
2140                     (ly:stencil-translate footnote-stencil
2141                                           (cons gap y-trans)))))))
2142          (main-stencil (ly:stencil-combine-at-edge
2143                          markup-stencil
2144                          X
2145                          RIGHT
2146                          (ly:make-stencil footnote-number x-ext y-ext)
2147                          padding)))
2148   (ly:stencil-add
2149     main-stencil
2150     (ly:make-stencil
2151       `(footnote ,footnote-hash #t ,(interpret-markup layout props note))
2152       '(0 . 0)
2153       '(0 . 0)))))
2154
2155 (define-markup-command (override layout props new-prop arg)
2156   (pair? markup?)
2157   #:category other
2158   "
2159 @cindex overriding properties within text markup
2160
2161 Add the argument @var{new-prop} to the property list.  Properties
2162 may be any property supported by @rinternals{font-interface},
2163 @rinternals{text-interface} and
2164 @rinternals{instrument-specific-markup-interface}.
2165
2166 @lilypond[verbatim,quote]
2167 \\markup {
2168   \\line {
2169     \\column {
2170       default
2171       baseline-skip
2172     }
2173     \\hspace #2
2174     \\override #'(baseline-skip . 4) {
2175       \\column {
2176         increased
2177         baseline-skip
2178       }
2179     }
2180   }
2181 }
2182 @end lilypond"
2183   (interpret-markup layout (cons (list new-prop) props) arg))
2184
2185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2186 ;; files
2187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2188
2189 (define-markup-command (verbatim-file layout props name)
2190   (string?)
2191   #:category other
2192   "Read the contents of file @var{name}, and include it verbatim.
2193
2194 @lilypond[verbatim,quote]
2195 \\markup {
2196   \\verbatim-file #\"simple.ly\"
2197 }
2198 @end lilypond"
2199   (interpret-markup layout props
2200                     (if  (ly:get-option 'safe)
2201                          "verbatim-file disabled in safe mode"
2202                          (let* ((str (ly:gulp-file name))
2203                                 (lines (string-split str #\nl)))
2204                            (make-typewriter-markup
2205                             (make-column-markup lines))))))
2206
2207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2208 ;; fonts.
2209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2210
2211
2212 (define-markup-command (smaller layout props arg)
2213   (markup?)
2214   #:category font
2215   "Decrease the font size relative to the current setting.
2216
2217 @lilypond[verbatim,quote]
2218 \\markup {
2219   \\fontsize #3.5 {
2220     some large text
2221     \\hspace #2
2222     \\smaller {
2223       a bit smaller
2224     }
2225     \\hspace #2
2226     more large text
2227   }
2228 }
2229 @end lilypond"
2230   (interpret-markup layout props
2231    `(,fontsize-markup -1 ,arg)))
2232
2233 (define-markup-command (larger layout props arg)
2234   (markup?)
2235   #:category font
2236   "Increase the font size relative to the current setting.
2237
2238 @lilypond[verbatim,quote]
2239 \\markup {
2240   default
2241   \\hspace #2
2242   \\larger
2243   larger
2244 }
2245 @end lilypond"
2246   (interpret-markup layout props
2247    `(,fontsize-markup 1 ,arg)))
2248
2249 (define-markup-command (finger layout props arg)
2250   (markup?)
2251   #:category font
2252   "Set @var{arg} as small numbers.
2253
2254 @lilypond[verbatim,quote]
2255 \\markup {
2256   \\finger {
2257     1 2 3 4 5
2258   }
2259 }
2260 @end lilypond"
2261   (interpret-markup layout
2262                     (cons '((font-size . -5) (font-encoding . fetaText)) props)
2263                     arg))
2264
2265 (define-markup-command (abs-fontsize layout props size arg)
2266   (number? markup?)
2267   #:category font
2268   "Use @var{size} as the absolute font size to display @var{arg}.
2269 Adjusts @code{baseline-skip} and @code{word-space} accordingly.
2270
2271 @lilypond[verbatim,quote]
2272 \\markup {
2273   default text font size
2274   \\hspace #2
2275   \\abs-fontsize #16 { text font size 16 }
2276   \\hspace #2
2277   \\abs-fontsize #12 { text font size 12 }
2278 }
2279 @end lilypond"
2280   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
2281          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
2282          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
2283          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
2284          (magnification (/ size ref-size)))
2285      (interpret-markup
2286       layout
2287       (cons
2288        `((baseline-skip . ,(* magnification ref-baseline))
2289          (word-space . ,(* magnification ref-word-space))
2290          (font-size . ,(magnification->font-size magnification)))
2291        props)
2292       arg)))
2293
2294 (define-markup-command (fontsize layout props increment arg)
2295   (number? markup?)
2296   #:category font
2297   #:properties ((font-size 0)
2298                 (word-space 1)
2299                 (baseline-skip 2))
2300   "Add @var{increment} to the font-size.  Adjusts @code{baseline-skip}
2301 accordingly.
2302
2303 @lilypond[verbatim,quote]
2304 \\markup {
2305   default
2306   \\hspace #2
2307   \\fontsize #-1.5
2308   smaller
2309 }
2310 @end lilypond"
2311   (interpret-markup
2312    layout
2313    (cons
2314     `((baseline-skip . ,(* baseline-skip (magstep increment)))
2315       (word-space . ,(* word-space (magstep increment)))
2316       (font-size . ,(+ font-size increment)))
2317     props)
2318    arg))
2319
2320 (define-markup-command (magnify layout props sz arg)
2321   (number? markup?)
2322   #:category font
2323   "
2324 @cindex magnifying text
2325
2326 Set the font magnification for its argument.  In the following
2327 example, the middle@tie{}A is 10% larger:
2328
2329 @example
2330 A \\magnify #1.1 @{ A @} A
2331 @end example
2332
2333 Note: Magnification only works if a font name is explicitly selected.
2334 Use @code{\\fontsize} otherwise.
2335
2336 @lilypond[verbatim,quote]
2337 \\markup {
2338   default
2339   \\hspace #2
2340   \\magnify #1.5 {
2341     50% larger
2342   }
2343 }
2344 @end lilypond"
2345   (interpret-markup
2346    layout
2347    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
2348    arg))
2349
2350 (define-markup-command (bold layout props arg)
2351   (markup?)
2352   #:category font
2353   "Switch to bold font-series.
2354
2355 @lilypond[verbatim,quote]
2356 \\markup {
2357   default
2358   \\hspace #2
2359   \\bold
2360   bold
2361 }
2362 @end lilypond"
2363   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
2364
2365 (define-markup-command (sans layout props arg)
2366   (markup?)
2367   #:category font
2368   "Switch to the sans serif font family.
2369
2370 @lilypond[verbatim,quote]
2371 \\markup {
2372   default
2373   \\hspace #2
2374   \\sans {
2375     sans serif
2376   }
2377 }
2378 @end lilypond"
2379   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
2380
2381 (define-markup-command (number layout props arg)
2382   (markup?)
2383   #:category font
2384   "Set font family to @code{number}, which yields the font used for
2385 time signatures and fingerings.  This font contains numbers and
2386 some punctuation; it has no letters.
2387
2388 @lilypond[verbatim,quote]
2389 \\markup {
2390   \\number {
2391     0 1 2 3 4 5 6 7 8 9 . ,
2392   }
2393 }
2394 @end lilypond"
2395   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2396
2397 (define-markup-command (roman layout props arg)
2398   (markup?)
2399   #:category font
2400   "Set font family to @code{roman}.
2401
2402 @lilypond[verbatim,quote]
2403 \\markup {
2404   \\sans \\bold {
2405     sans serif, bold
2406     \\hspace #2
2407     \\roman {
2408       text in roman font family
2409     }
2410     \\hspace #2
2411     return to sans
2412   }
2413 }
2414 @end lilypond"
2415   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
2416
2417 (define-markup-command (huge layout props arg)
2418   (markup?)
2419   #:category font
2420   "Set font size to +2.
2421
2422 @lilypond[verbatim,quote]
2423 \\markup {
2424   default
2425   \\hspace #2
2426   \\huge
2427   huge
2428 }
2429 @end lilypond"
2430   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
2431
2432 (define-markup-command (large layout props arg)
2433   (markup?)
2434   #:category font
2435   "Set font size to +1.
2436
2437 @lilypond[verbatim,quote]
2438 \\markup {
2439   default
2440   \\hspace #2
2441   \\large
2442   large
2443 }
2444 @end lilypond"
2445   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
2446
2447 (define-markup-command (normalsize layout props arg)
2448   (markup?)
2449   #:category font
2450   "Set font size to default.
2451
2452 @lilypond[verbatim,quote]
2453 \\markup {
2454   \\teeny {
2455     this is very small
2456     \\hspace #2
2457     \\normalsize {
2458       normal size
2459     }
2460     \\hspace #2
2461     teeny again
2462   }
2463 }
2464 @end lilypond"
2465   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
2466
2467 (define-markup-command (small layout props arg)
2468   (markup?)
2469   #:category font
2470   "Set font size to -1.
2471
2472 @lilypond[verbatim,quote]
2473 \\markup {
2474   default
2475   \\hspace #2
2476   \\small
2477   small
2478 }
2479 @end lilypond"
2480   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
2481
2482 (define-markup-command (tiny layout props arg)
2483   (markup?)
2484   #:category font
2485   "Set font size to -2.
2486
2487 @lilypond[verbatim,quote]
2488 \\markup {
2489   default
2490   \\hspace #2
2491   \\tiny
2492   tiny
2493 }
2494 @end lilypond"
2495   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
2496
2497 (define-markup-command (teeny layout props arg)
2498   (markup?)
2499   #:category font
2500   "Set font size to -3.
2501
2502 @lilypond[verbatim,quote]
2503 \\markup {
2504   default
2505   \\hspace #2
2506   \\teeny
2507   teeny
2508 }
2509 @end lilypond"
2510   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
2511
2512 (define-markup-command (fontCaps layout props arg)
2513   (markup?)
2514   #:category font
2515   "Set @code{font-shape} to @code{caps}
2516
2517 Note: @code{\\fontCaps} requires the installation and selection of
2518 fonts which support the @code{caps} font shape."
2519   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
2520
2521 ;; Poor man's caps
2522 (define-markup-command (smallCaps layout props arg)
2523   (markup?)
2524   #:category font
2525   "Emit @var{arg} as small caps.
2526
2527 Note: @code{\\smallCaps} does not support accented characters.
2528
2529 @lilypond[verbatim,quote]
2530 \\markup {
2531   default
2532   \\hspace #2
2533   \\smallCaps {
2534     Text in small caps
2535   }
2536 }
2537 @end lilypond"
2538   (define (char-list->markup chars lower)
2539     (let ((final-string (string-upcase (reverse-list->string chars))))
2540       (if lower
2541           (markup #:fontsize -2 final-string)
2542           final-string)))
2543   (define (make-small-caps rest-chars currents current-is-lower prev-result)
2544     (if (null? rest-chars)
2545         (make-concat-markup
2546           (reverse! (cons (char-list->markup currents current-is-lower)
2547                           prev-result)))
2548         (let* ((ch (car rest-chars))
2549                (is-lower (char-lower-case? ch)))
2550           (if (or (and current-is-lower is-lower)
2551                   (and (not current-is-lower) (not is-lower)))
2552               (make-small-caps (cdr rest-chars)
2553                                (cons ch currents)
2554                                is-lower
2555                                prev-result)
2556               (make-small-caps (cdr rest-chars)
2557                                (list ch)
2558                                is-lower
2559                                (if (null? currents)
2560                                    prev-result
2561                                    (cons (char-list->markup
2562                                             currents current-is-lower)
2563                                          prev-result)))))))
2564   (interpret-markup layout props
2565     (if (string? arg)
2566         (make-small-caps (string->list arg) (list) #f (list))
2567         arg)))
2568
2569 (define-markup-command (caps layout props arg)
2570   (markup?)
2571   #:category font
2572   "Copy of the @code{\\smallCaps} command.
2573
2574 @lilypond[verbatim,quote]
2575 \\markup {
2576   default
2577   \\hspace #2
2578   \\caps {
2579     Text in small caps
2580   }
2581 }
2582 @end lilypond"
2583   (interpret-markup layout props (make-smallCaps-markup arg)))
2584
2585 (define-markup-command (dynamic layout props arg)
2586   (markup?)
2587   #:category font
2588   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
2589 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
2590 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
2591 done in a different font.  The recommended font for this is bold and italic.
2592 @lilypond[verbatim,quote]
2593 \\markup {
2594   \\dynamic {
2595     sfzp
2596   }
2597 }
2598 @end lilypond"
2599   (interpret-markup
2600    layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2601
2602 (define-markup-command (text layout props arg)
2603   (markup?)
2604   #:category font
2605   "Use a text font instead of music symbol or music alphabet font.
2606
2607 @lilypond[verbatim,quote]
2608 \\markup {
2609   \\number {
2610     1, 2,
2611     \\text {
2612       three, four,
2613     }
2614     5
2615   }
2616 }
2617 @end lilypond"
2618
2619   ;; ugh - latin1
2620   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
2621                     arg))
2622
2623 (define-markup-command (italic layout props arg)
2624   (markup?)
2625   #:category font
2626   "Use italic @code{font-shape} for @var{arg}.
2627
2628 @lilypond[verbatim,quote]
2629 \\markup {
2630   default
2631   \\hspace #2
2632   \\italic
2633   italic
2634 }
2635 @end lilypond"
2636   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
2637
2638 (define-markup-command (typewriter layout props arg)
2639   (markup?)
2640   #:category font
2641   "Use @code{font-family} typewriter for @var{arg}.
2642
2643 @lilypond[verbatim,quote]
2644 \\markup {
2645   default
2646   \\hspace #2
2647   \\typewriter
2648   typewriter
2649 }
2650 @end lilypond"
2651   (interpret-markup
2652    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
2653
2654 (define-markup-command (upright layout props arg)
2655   (markup?)
2656   #:category font
2657   "Set @code{font-shape} to @code{upright}.  This is the opposite
2658 of @code{italic}.
2659
2660 @lilypond[verbatim,quote]
2661 \\markup {
2662   \\italic {
2663     italic text
2664     \\hspace #2
2665     \\upright {
2666       upright text
2667     }
2668     \\hspace #2
2669     italic again
2670   }
2671 }
2672 @end lilypond"
2673   (interpret-markup
2674    layout (prepend-alist-chain 'font-shape 'upright props) arg))
2675
2676 (define-markup-command (medium layout props arg)
2677   (markup?)
2678   #:category font
2679   "Switch to medium font-series (in contrast to bold).
2680
2681 @lilypond[verbatim,quote]
2682 \\markup {
2683   \\bold {
2684     some bold text
2685     \\hspace #2
2686     \\medium {
2687       medium font series
2688     }
2689     \\hspace #2
2690     bold again
2691   }
2692 }
2693 @end lilypond"
2694   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2695                     arg))
2696
2697 (define-markup-command (normal-text layout props arg)
2698   (markup?)
2699   #:category font
2700   "Set all font related properties (except the size) to get the default
2701 normal text font, no matter what font was used earlier.
2702
2703 @lilypond[verbatim,quote]
2704 \\markup {
2705   \\huge \\bold \\sans \\caps {
2706     huge bold sans caps
2707     \\hspace #2
2708     \\normal-text {
2709       huge normal
2710     }
2711     \\hspace #2
2712     as before
2713   }
2714 }
2715 @end lilypond"
2716   ;; ugh - latin1
2717   (interpret-markup layout
2718                     (cons '((font-family . roman) (font-shape . upright)
2719                             (font-series . medium) (font-encoding . latin1))
2720                           props)
2721                     arg))
2722
2723 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2724 ;; symbols.
2725 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2726
2727 (define-markup-command (musicglyph layout props glyph-name)
2728   (string?)
2729   #:category music
2730   "@var{glyph-name} is converted to a musical symbol; for example,
2731 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2732 the music font.  See @ruser{The Feta font} for a complete listing of
2733 the possible glyphs.
2734
2735 @lilypond[verbatim,quote]
2736 \\markup {
2737   \\musicglyph #\"f\"
2738   \\musicglyph #\"rests.2\"
2739   \\musicglyph #\"clefs.G_change\"
2740 }
2741 @end lilypond"
2742   (let* ((font (ly:paper-get-font layout
2743                                   (cons '((font-encoding . fetaMusic)
2744                                           (font-name . #f))
2745
2746                                                  props)))
2747          (glyph (ly:font-get-glyph font glyph-name)))
2748     (if (null? (ly:stencil-expr glyph))
2749         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2750
2751     glyph))
2752
2753 (define-markup-command (doublesharp layout props)
2754   ()
2755   #:category music
2756   "Draw a double sharp symbol.
2757
2758 @lilypond[verbatim,quote]
2759 \\markup {
2760   \\doublesharp
2761 }
2762 @end lilypond"
2763   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2764
2765 (define-markup-command (sesquisharp layout props)
2766   ()
2767   #:category music
2768   "Draw a 3/2 sharp symbol.
2769
2770 @lilypond[verbatim,quote]
2771 \\markup {
2772   \\sesquisharp
2773 }
2774 @end lilypond"
2775   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
2776
2777 (define-markup-command (sharp layout props)
2778   ()
2779   #:category music
2780   "Draw a sharp symbol.
2781
2782 @lilypond[verbatim,quote]
2783 \\markup {
2784   \\sharp
2785 }
2786 @end lilypond"
2787   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2788
2789 (define-markup-command (semisharp layout props)
2790   ()
2791   #:category music
2792   "Draw a semisharp symbol.
2793
2794 @lilypond[verbatim,quote]
2795 \\markup {
2796   \\semisharp
2797 }
2798 @end lilypond"
2799   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2800
2801 (define-markup-command (natural layout props)
2802   ()
2803   #:category music
2804   "Draw a natural symbol.
2805
2806 @lilypond[verbatim,quote]
2807 \\markup {
2808   \\natural
2809 }
2810 @end lilypond"
2811   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2812
2813 (define-markup-command (semiflat layout props)
2814   ()
2815   #:category music
2816   "Draw a semiflat symbol.
2817
2818 @lilypond[verbatim,quote]
2819 \\markup {
2820   \\semiflat
2821 }
2822 @end lilypond"
2823   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2824
2825 (define-markup-command (flat layout props)
2826   ()
2827   #:category music
2828   "Draw a flat symbol.
2829
2830 @lilypond[verbatim,quote]
2831 \\markup {
2832   \\flat
2833 }
2834 @end lilypond"
2835   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2836
2837 (define-markup-command (sesquiflat layout props)
2838   ()
2839   #:category music
2840   "Draw a 3/2 flat symbol.
2841
2842 @lilypond[verbatim,quote]
2843 \\markup {
2844   \\sesquiflat
2845 }
2846 @end lilypond"
2847   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2848
2849 (define-markup-command (doubleflat layout props)
2850   ()
2851   #:category music
2852   "Draw a double flat symbol.
2853
2854 @lilypond[verbatim,quote]
2855 \\markup {
2856   \\doubleflat
2857 }
2858 @end lilypond"
2859   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2860
2861 (define-markup-command (with-color layout props color arg)
2862   (color? markup?)
2863   #:category other
2864   "
2865 @cindex coloring text
2866
2867 Draw @var{arg} in color specified by @var{color}.
2868
2869 @lilypond[verbatim,quote]
2870 \\markup {
2871   \\with-color #red
2872   red
2873   \\hspace #2
2874   \\with-color #green
2875   green
2876   \\hspace #2
2877   \\with-color #blue
2878   blue
2879 }
2880 @end lilypond"
2881   (let ((stil (interpret-markup layout props arg)))
2882     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2883                      (ly:stencil-extent stil X)
2884                      (ly:stencil-extent stil Y))))
2885
2886 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2887 ;; glyphs
2888 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2889
2890 (define-markup-command (arrow-head layout props axis dir filled)
2891   (integer? ly:dir? boolean?)
2892   #:category graphic
2893   "Produce an arrow head in specified direction and axis.
2894 Use the filled head if @var{filled} is specified.
2895 @lilypond[verbatim,quote]
2896 \\markup {
2897   \\fontsize #5 {
2898     \\general-align #Y #DOWN {
2899       \\arrow-head #Y #UP ##t
2900       \\arrow-head #Y #DOWN ##f
2901       \\hspace #2
2902       \\arrow-head #X #RIGHT ##f
2903       \\arrow-head #X #LEFT ##f
2904     }
2905   }
2906 }
2907 @end lilypond"
2908   (let*
2909       ((name (format #f "arrowheads.~a.~a~a"
2910                      (if filled
2911                          "close"
2912                          "open")
2913                      axis
2914                      dir)))
2915     (ly:font-get-glyph
2916      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2917                                      props))
2918      name)))
2919
2920 (define-markup-command (lookup layout props glyph-name)
2921   (string?)
2922   #:category other
2923   "Lookup a glyph by name.
2924
2925 @lilypond[verbatim,quote]
2926 \\markup {
2927   \\override #'(font-encoding . fetaBraces) {
2928     \\lookup #\"brace200\"
2929     \\hspace #2
2930     \\rotate #180
2931     \\lookup #\"brace180\"
2932   }
2933 }
2934 @end lilypond"
2935   (ly:font-get-glyph (ly:paper-get-font layout props)
2936                      glyph-name))
2937
2938 (define-markup-command (char layout props num)
2939   (integer?)
2940   #:category other
2941   "Produce a single character.  Characters encoded in hexadecimal
2942 format require the prefix @code{#x}.
2943
2944 @lilypond[verbatim,quote]
2945 \\markup {
2946   \\char #65 \\char ##x00a9
2947 }
2948 @end lilypond"
2949   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2950
2951 (define number->mark-letter-vector (make-vector 25 #\A))
2952
2953 (do ((i 0 (1+ i))
2954      (j 0 (1+ j)))
2955     ((>= i 26))
2956   (if (= i (- (char->integer #\I) (char->integer #\A)))
2957       (set! i (1+ i)))
2958   (vector-set! number->mark-letter-vector j
2959                (integer->char (+ i (char->integer #\A)))))
2960
2961 (define number->mark-alphabet-vector (list->vector
2962   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2963
2964 (define (number->markletter-string vec n)
2965   "Double letters for big marks."
2966   (let* ((lst (vector-length vec)))
2967
2968     (if (>= n lst)
2969         (string-append (number->markletter-string vec (1- (quotient n lst)))
2970                        (number->markletter-string vec (remainder n lst)))
2971         (make-string 1 (vector-ref vec n)))))
2972
2973 (define-markup-command (markletter layout props num)
2974   (integer?)
2975   #:category other
2976   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2977 (skipping letter@tie{}I), and continue with double letters.
2978
2979 @lilypond[verbatim,quote]
2980 \\markup {
2981   \\markletter #8
2982   \\hspace #2
2983   \\markletter #26
2984 }
2985 @end lilypond"
2986   (ly:text-interface::interpret-markup layout props
2987     (number->markletter-string number->mark-letter-vector num)))
2988
2989 (define-markup-command (markalphabet layout props num)
2990   (integer?)
2991   #:category other
2992    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2993 and continue with double letters.
2994
2995 @lilypond[verbatim,quote]
2996 \\markup {
2997   \\markalphabet #8
2998   \\hspace #2
2999   \\markalphabet #26
3000 }
3001 @end lilypond"
3002    (ly:text-interface::interpret-markup layout props
3003      (number->markletter-string number->mark-alphabet-vector num)))
3004
3005 (define-public (horizontal-slash-interval num forward number-interval mag)
3006   (if forward
3007     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
3008           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
3009           (else (interval-widen number-interval (* mag 0.25))))
3010     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
3011           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
3012           (else (interval-widen number-interval (* mag 0.25))))
3013   ))
3014
3015 (define-public (adjust-slash-stencil num forward stencil mag)
3016   (if forward
3017     (cond ((= num 2)
3018               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
3019           ((= num 3)
3020               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
3021           ;((= num 5)
3022               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
3023           ;((= num 7)
3024           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
3025           (else stencil))
3026     (cond ((= num 6)
3027               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
3028           ;((= num 8)
3029           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
3030           (else stencil))
3031   )
3032 )
3033
3034 (define (slashed-digit-internal layout props num forward font-size thickness)
3035   (let* ((mag (magstep font-size))
3036          (thickness (* mag
3037                        (ly:output-def-lookup layout 'line-thickness)
3038                        thickness))
3039          ; backward slashes might use slope and point in the other direction!
3040          (dy (* mag (if forward 0.4 -0.4)))
3041          (number-stencil (interpret-markup layout
3042                                            (prepend-alist-chain 'font-encoding 'fetaText props)
3043                                            (number->string num)))
3044          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
3045          (center (interval-center (ly:stencil-extent number-stencil Y)))
3046          ; Use the real extents of the slash, not the whole number, because we
3047          ; might translate the slash later on!
3048          (num-y (interval-widen (cons center center) (abs dy)))
3049          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
3050          (slash-stencil (if is-sane
3051                             (make-line-stencil thickness
3052                                          (car num-x) (- (interval-center num-y) dy)
3053                                          (cdr num-x) (+ (interval-center num-y) dy))
3054                             #f)))
3055     (if (ly:stencil? slash-stencil)
3056       (begin
3057         ; for some numbers we need to shift the slash/backslash up or down to make
3058         ; the slashed digit look better
3059         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
3060         (set! number-stencil
3061           (ly:stencil-add number-stencil slash-stencil)))
3062       (ly:warning "Unable to create slashed digit ~a" num))
3063     number-stencil))
3064
3065
3066 (define-markup-command (slashed-digit layout props num)
3067   (integer?)
3068   #:category other
3069   #:properties ((font-size 0)
3070                 (thickness 1.6))
3071   "
3072 @cindex slashed digits
3073
3074 A feta number, with slash.  This is for use in the context of
3075 figured bass notation.
3076 @lilypond[verbatim,quote]
3077 \\markup {
3078   \\slashed-digit #5
3079   \\hspace #2
3080   \\override #'(thickness . 3)
3081   \\slashed-digit #7
3082 }
3083 @end lilypond"
3084   (slashed-digit-internal layout props num #t font-size thickness))
3085
3086 (define-markup-command (backslashed-digit layout props num)
3087   (integer?)
3088   #:category other
3089   #:properties ((font-size 0)
3090                 (thickness 1.6))
3091   "
3092 @cindex backslashed digits
3093
3094 A feta number, with backslash.  This is for use in the context of
3095 figured bass notation.
3096 @lilypond[verbatim,quote]
3097 \\markup {
3098   \\backslashed-digit #5
3099   \\hspace #2
3100   \\override #'(thickness . 3)
3101   \\backslashed-digit #7
3102 }
3103 @end lilypond"
3104   (slashed-digit-internal layout props num #f font-size thickness))
3105
3106 ;; eyeglasses
3107 (define eyeglassespath
3108   '((moveto 0.42 0.77)
3109     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
3110     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
3111     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
3112     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
3113     (closepath)
3114     (moveto 2.07 0.77)
3115     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
3116     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
3117     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
3118     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
3119     (closepath)
3120     (moveto 1.025 0.935)
3121     (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33)
3122     (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33)
3123     (moveto -0.68 0.77)
3124     (rlineto 0.66 1.43)
3125     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)
3126     (moveto 2.07 0.77)
3127     (rlineto 0.66 1.43)
3128     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)))
3129
3130 (define-markup-command (eyeglasses layout props)
3131   ()
3132   #:category other
3133   "Prints out eyeglasses, indicating strongly to look at the conductor.
3134 @lilypond[verbatim,quote]
3135 \\markup { \\eyeglasses }
3136 @end lilypond"
3137   (interpret-markup layout props
3138     (make-override-markup '(line-cap-style . butt)
3139       (make-path-markup 0.15 eyeglassespath))))
3140
3141 (define-markup-command (left-brace layout props size)
3142   (number?)
3143   #:category other
3144   "
3145 A feta brace in point size @var{size}.
3146
3147 @lilypond[verbatim,quote]
3148 \\markup {
3149   \\left-brace #35
3150   \\hspace #2
3151   \\left-brace #45
3152 }
3153 @end lilypond"
3154   (let* ((font (ly:paper-get-font layout
3155                                   (cons '((font-encoding . fetaBraces)
3156                                           (font-name . #f))
3157                                         props)))
3158          (glyph-count (1- (ly:otf-glyph-count font)))
3159          (scale (ly:output-def-lookup layout 'output-scale))
3160          (scaled-size (/ (ly:pt size) scale))
3161          (glyph (lambda (n)
3162                   (ly:font-get-glyph font (string-append "brace"
3163                                                          (number->string n)))))
3164          (get-y-from-brace (lambda (brace)
3165                              (interval-length
3166                               (ly:stencil-extent (glyph brace) Y))))
3167          (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size))
3168          (glyph-found (glyph find-brace)))
3169
3170     (if (or (null? (ly:stencil-expr glyph-found))
3171             (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
3172             (> scaled-size (interval-length
3173                             (ly:stencil-extent (glyph glyph-count) Y))))
3174         (begin
3175           (ly:warning (_ "no brace found for point size ~S ") size)
3176           (ly:warning (_ "defaulting to ~S pt")
3177                       (/ (* scale (interval-length
3178                                    (ly:stencil-extent glyph-found Y)))
3179                          (ly:pt 1)))))
3180     glyph-found))
3181
3182 (define-markup-command (right-brace layout props size)
3183   (number?)
3184   #:category other
3185   "
3186 A feta brace in point size @var{size}, rotated 180 degrees.
3187
3188 @lilypond[verbatim,quote]
3189 \\markup {
3190   \\right-brace #45
3191   \\hspace #2
3192   \\right-brace #35
3193 }
3194 @end lilypond"
3195   (interpret-markup layout props (markup #:rotate 180 #:left-brace size)))
3196
3197 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3198 ;; the note command.
3199 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3200
3201 ;; TODO: better syntax.
3202
3203 (define-markup-command (note-by-number layout props log dot-count dir)
3204   (number? number? number?)
3205   #:category music
3206   #:properties ((font-size 0)
3207                 (style '()))
3208   "
3209 @cindex notes within text by log and dot-count
3210
3211 Construct a note symbol, with stem.  By using fractional values for
3212 @var{dir}, longer or shorter stems can be obtained.
3213
3214 @lilypond[verbatim,quote]
3215 \\markup {
3216   \\note-by-number #3 #0 #DOWN
3217   \\hspace #2
3218   \\note-by-number #1 #2 #0.8
3219 }
3220 @end lilypond"
3221   (define (get-glyph-name-candidates dir log style)
3222     (map (lambda (dir-name)
3223            (format #f "noteheads.~a~a" dir-name
3224                    (if (and (symbol? style)
3225                             (not (equal? 'default style)))
3226                        (select-head-glyph style (min log 2))
3227                        (min log 2))))
3228          (list (if (= dir UP) "u" "d")
3229                "s")))
3230
3231   (define (get-glyph-name font cands)
3232     (if (null? cands)
3233         ""
3234         (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
3235             (get-glyph-name font (cdr cands))
3236             (car cands))))
3237
3238   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
3239                                                props)))
3240          (size-factor (magstep font-size))
3241          (stem-length (* size-factor (max 3 (- log 1))))
3242          (head-glyph-name
3243           (let ((result (get-glyph-name font (get-glyph-name-candidates
3244                                               (sign dir) log style))))
3245             (if (string-null? result)
3246                 ;; If no glyph name can be found, select default heads.  Though
3247                 ;; this usually means an unsupported style has been chosen, it
3248                 ;; also prevents unrelated 'style settings from other grobs
3249                 ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
3250                 (get-glyph-name font (get-glyph-name-candidates
3251                                       (sign dir) log 'default))
3252                 result)))
3253          (head-glyph (ly:font-get-glyph font head-glyph-name))
3254          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
3255          (stem-thickness (* size-factor 0.13))
3256          (stemy (* dir stem-length))
3257          (attach-off (cons (interval-index
3258                             (ly:stencil-extent head-glyph X)
3259                             (* (sign dir) (car attach-indices)))
3260                            (* (sign dir) ; fixme, this is inconsistent between X & Y.
3261                               (interval-index
3262                                (ly:stencil-extent head-glyph Y)
3263                                (cdr attach-indices)))))
3264          (stem-glyph (and (> log 0)
3265                           (ly:round-filled-box
3266                            (ordered-cons (car attach-off)
3267                                          (+ (car attach-off)
3268                                             (* (- (sign dir)) stem-thickness)))
3269                            (cons (min stemy (cdr attach-off))
3270                                  (max stemy (cdr attach-off)))
3271                            (/ stem-thickness 3))))
3272
3273          (dot (ly:font-get-glyph font "dots.dot"))
3274          (dotwid (interval-length (ly:stencil-extent dot X)))
3275          (dots (and (> dot-count 0)
3276                     (apply ly:stencil-add
3277                            (map (lambda (x)
3278                                   (ly:stencil-translate-axis
3279                                    dot (* 2 x dotwid) X))
3280                                 (iota dot-count)))))
3281          (flaggl (and (> log 2)
3282                       (ly:stencil-translate
3283                        (ly:font-get-glyph font
3284                                           (string-append "flags."
3285                                                          (if (> dir 0) "u" "d")
3286                                                          (number->string log)))
3287                        (cons (+ (car attach-off) (if (< dir 0)
3288                                                      stem-thickness 0))
3289                              stemy)))))
3290
3291     ;; If there is a flag on an upstem and the stem is short, move the dots
3292     ;; to avoid the flag.  16th notes get a special case because their flags
3293     ;; hang lower than any other flags.
3294     (if (and dots (> dir 0) (> log 2)
3295              (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
3296         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
3297     (if flaggl
3298         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
3299     (if (ly:stencil? stem-glyph)
3300         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
3301         (set! stem-glyph head-glyph))
3302     (if (ly:stencil? dots)
3303         (set! stem-glyph
3304               (ly:stencil-add
3305                (ly:stencil-translate-axis
3306                 dots
3307                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
3308                 X)
3309                stem-glyph)))
3310     stem-glyph))
3311
3312 (define-public log2
3313   (let ((divisor (log 2)))
3314     (lambda (z) (inexact->exact (/ (log z) divisor)))))
3315
3316 (define (parse-simple-duration duration-string)
3317   "Parse the `duration-string', e.g. ''4..'' or ''breve.'',
3318 and return a (log dots) list."
3319   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)")
3320                             duration-string)))
3321     (if (and match (string=? duration-string (match:substring match 0)))
3322         (let ((len (match:substring match 1))
3323               (dots (match:substring match 2)))
3324           (list (cond ((string=? len "breve") -1)
3325                       ((string=? len "longa") -2)
3326                       ((string=? len "maxima") -3)
3327                       (else (log2 (string->number len))))
3328                 (if dots (string-length dots) 0)))
3329         (ly:error (_ "not a valid duration string: ~a") duration-string))))
3330
3331 (define-markup-command (note layout props duration dir)
3332   (string? number?)
3333   #:category music
3334   #:properties (note-by-number-markup)
3335   "
3336 @cindex notes within text by string
3337
3338 This produces a note with a stem pointing in @var{dir} direction, with
3339 the @var{duration} for the note head type and augmentation dots.  For
3340 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
3341 a shortened down stem.
3342
3343 @lilypond[verbatim,quote]
3344 \\markup {
3345   \\override #'(style . cross) {
3346     \\note #\"4..\" #UP
3347   }
3348   \\hspace #2
3349   \\note #\"breve\" #0
3350 }
3351 @end lilypond"
3352   (let ((parsed (parse-simple-duration duration)))
3353     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
3354
3355 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3356 ;; the rest command.
3357 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3358
3359 (define-markup-command (rest-by-number layout props log dot-count)
3360   (number? number?)
3361   #:category music
3362   #:properties ((font-size 0)
3363                 (style '())
3364                 (multi-measure-rest #f))
3365   "
3366 @cindex rests or multi-measure-rests within text by log and dot-count
3367
3368 A rest or multi-measure-rest symbol.
3369
3370 @lilypond[verbatim,quote]
3371 \\markup {
3372   \\rest-by-number #3 #2
3373   \\hspace #2
3374   \\rest-by-number #0 #1
3375   \\hspace #2
3376   \\override #'(multi-measure-rest . #t)
3377   \\rest-by-number #0 #0
3378 }
3379 @end lilypond"
3380
3381   (define (get-glyph-name-candidates log style)
3382     (let* (;; Choose the style-string to be added.
3383            ;; If no glyph exists, select others for the specified styles
3384            ;; otherwise defaulting.
3385            (style-strg
3386              (cond (
3387                    ;; 'baroque needs to be special-cased, otherwise
3388                    ;; `select-head-glyph´ would catch neomensural-glyphs for
3389                    ;; this style, if (< log 0).
3390                    (eq? style 'baroque)
3391                     (string-append (number->string log) ""))
3392                    ((eq? style 'petrucci)
3393                     (string-append (number->string log) "mensural"))
3394                     ;; In other cases `select-head-glyph´ from output-lib.scm
3395                     ;; works for rest-glyphs, too.
3396                    ((and (symbol? style) (not (eq? style 'default)))
3397                     (select-head-glyph style log))
3398                    (else log)))
3399            ;; Choose ledgered glyphs for whole and half rest.
3400            ;; Except for the specified styles, logs and MultiMeasureRests.
3401            (ledger-style-rests
3402              (if (and (or (list? style)
3403                           (not (member style
3404                                   '(neomensural mensural petrucci))))
3405                       (not multi-measure-rest)
3406                       (or (= log 0) (= log 1)))
3407                 "o"
3408                 "")))
3409       (format #f "rests.~a~a" style-strg ledger-style-rests)))
3410
3411   (define (get-glyph-name font cands)
3412      (if (ly:stencil-empty? (ly:font-get-glyph font cands))
3413         ""
3414         cands))
3415
3416   (let* ((font
3417            (ly:paper-get-font layout
3418              (cons '((font-encoding . fetaMusic)) props)))
3419          (rest-glyph-name
3420             (let ((result
3421                     (get-glyph-name font
3422                       (get-glyph-name-candidates log style))))
3423               (if (string-null? result)
3424                 ;; If no glyph name can be found, select default rests.  Though
3425                 ;; this usually means an unsupported style has been chosen, it
3426                 ;; also prevents unrelated 'style settings from other grobs
3427                 ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
3428                 (get-glyph-name font (get-glyph-name-candidates log 'default))
3429                 result)))
3430          (rest-glyph (ly:font-get-glyph font rest-glyph-name))
3431          (dot (ly:font-get-glyph font "dots.dot"))
3432          (dot-width (interval-length (ly:stencil-extent dot X)))
3433          (dots (and (> dot-count 0)
3434                     (apply ly:stencil-add
3435                            (map (lambda (x)
3436                                   (ly:stencil-translate-axis
3437                                    dot (* 2 x dot-width) X))
3438                                 (iota dot-count))))))
3439
3440     ;; Apart from mensural-, neomensural- and petrucci-style ledgered
3441     ;; glyphs are taken for whole and half rests.
3442     ;; If they are dotted, move the dots in X-direction to avoid collision.
3443     (if (and dots
3444              (< log 2)
3445              (>= log 0)
3446              (not (member style '(neomensural mensural petrucci))))
3447        (set! dots (ly:stencil-translate-axis dots dot-width X)))
3448
3449     ;; Add dots to the rest-glyph.
3450     ;;
3451     ;; Not sure how to vertical align dots.
3452     ;; For now the dots are centered for half, whole or longer rests.
3453     ;; Otherwise placed near the top of the rest.
3454     ;;
3455     ;; Dots for rests with (< log 0) dots are allowed, but not
3456     ;; if multi-measure-rest is set #t.
3457     (if (and (not multi-measure-rest) dots)
3458         (set! rest-glyph
3459               (ly:stencil-add
3460                (ly:stencil-translate
3461                    dots
3462                         (cons
3463                            (+ (cdr (ly:stencil-extent rest-glyph X)) dot-width)
3464                            (if (< log 2)
3465                              (interval-center (ly:stencil-extent rest-glyph Y))
3466                              (- (interval-end (ly:stencil-extent rest-glyph Y))
3467                                 (/ (* 2 dot-width) 3)))))
3468                rest-glyph)))
3469     rest-glyph))
3470
3471 (define-markup-command (rest layout props duration)
3472   (string?)
3473   #:category music
3474   #:properties ((style '())
3475                 (multi-measure-rest #f)
3476                 (multi-measure-rest-number #t)
3477                 (word-space 0.6))
3478   "
3479 @cindex rests or multi-measure-rests within text by string
3480
3481 This produces a rest, with the @var{duration} for the rest type and
3482 augmentation dots.
3483 @code{\"breve\"}, @code{\"longa\"} and @code{\"maxima\"} are valid
3484 input-strings.
3485
3486 Printing MultiMeasureRests could be enabled with
3487 @code{\\override #'(multi-measure-rest . #t)}
3488 If MultiMeasureRests are taken, the MultiMeasureRestNumber is printed above.
3489 This is enabled for all styles using default-glyphs.
3490 Could be disabled with @code{\\override #'(multi-measure-rest-number . #f)}
3491
3492 @lilypond[verbatim,quote]
3493 \\markup {
3494   \\rest #\"4..\"
3495   \\hspace #2
3496   \\rest #\"breve\"
3497   \\hspace #2
3498   \\override #'(multi-measure-rest . #t)
3499   {
3500   \\rest #\"7\"
3501   \\hspace #2
3502   \\override #'(multi-measure-rest-number . #f)
3503   \\rest #\"7\"
3504   }
3505 }
3506 @end lilypond"
3507   ;; Get the number of mmr-glyphs.
3508   ;; Store them in a list.
3509   ;; example: (mmr-numbers 25) -> '(3 0 0 1)
3510   (define (mmr-numbers nmbr)
3511       (let* ((8-bar-glyph (floor (/ nmbr 8)))
3512              (8-remainder (remainder nmbr 8))
3513              (4-bar-glyph (floor (/ 8-remainder 4)))
3514              (4-remainder (remainder nmbr 4))
3515              (2-bar-glyph (floor (/ 4-remainder 2)))
3516              (2-remainder (remainder 4-remainder 2))
3517              (1-bar-glyph (floor (/ 2-remainder 1))))
3518        (list 8-bar-glyph 4-bar-glyph 2-bar-glyph 1-bar-glyph)))
3519
3520   ;; Get the correct mmr-glyphs.
3521   ;; Store them in a list.
3522   ;; example:
3523   ;; (get-mmr-glyphs '(1 0 1 0) '("rests.M3" "rests.M2" "rests.M1" "rests.0"))
3524   ;; -> ("rests.M3" "rests.M1")
3525   (define (get-mmr-glyphs lst1 lst2)
3526      (define (helper l1 l2 l3)
3527         (if (null? l1)
3528            (reverse l3)
3529            (helper (cdr l1)
3530                    (cdr l2)
3531                    (append (make-list (car l1) (car l2)) l3))))
3532       (helper lst1 lst2 '()))
3533
3534   ;; If duration is not valid, print a warning and return empty-stencil
3535   (if (or (and (not (integer? (car (parse-simple-duration duration))))
3536                (not multi-measure-rest))
3537           (and (= (string-length (car (string-split duration #\. ))) 1)
3538                (= (string->number (car (string-split duration #\. ))) 0)))
3539     (begin
3540       (ly:warning (_ "not a valid duration string: ~a - ignoring") duration)
3541       empty-stencil)
3542     (let* (
3543        ;; For simple rests:
3544            ;; Get a (log dots) list.
3545            (parsed (parse-simple-duration duration))
3546            ;; Create the rest-stencil
3547            (stil
3548               (rest-by-number-markup layout props (car parsed) (cadr parsed)))
3549        ;; For MultiMeasureRests:
3550            ;; Get the duration-part of duration
3551            (dur-part-string (car (string-split duration #\. )))
3552            ;; Get the duration of MMR:
3553            ;; If not a number (eg. "maxima") calculate it.
3554            (mmr-duration
3555              (or (string->number dur-part-string) (expt 2 (abs (car parsed)))))
3556            ;; Get a list of the correct number of each mmr-glyph.
3557            (count-mmr-glyphs-list (mmr-numbers mmr-duration))
3558            ;; Create a list of mmr-stencils,
3559            ;; translating the glyph for a whole rest.
3560            (mmr-stils-list
3561               (map
3562                  (lambda (x)
3563                     (let ((single-mmr-stil
3564                             (rest-by-number-markup layout props (* -1 x) 0)))
3565                        (if (= x 0)
3566                           (ly:stencil-translate-axis
3567                             single-mmr-stil
3568                             ;; Ugh, hard-coded, why 1?
3569                             1
3570                             Y)
3571                            single-mmr-stil)))
3572                  (get-mmr-glyphs count-mmr-glyphs-list (reverse (iota 4)))))
3573             ;; Adjust the space between the mmr-glyphs,
3574             ;; if not default-glyphs are used.
3575             (word-space (if (member style
3576                                     '(neomensural mensural petrucci))
3577                            (/ (* word-space 2) 3)
3578                            word-space))
3579             ;; Create the final mmr-stencil
3580             ;; via `stack-stencil-line´ from /scm/markup.scm
3581             (mmr-stil (stack-stencil-line word-space mmr-stils-list)))
3582
3583       ;; Print the number above a multi-measure-rest
3584       ;; Depends on duration, style and multi-measure-rest-number set #t
3585       (if (and multi-measure-rest
3586                multi-measure-rest-number
3587                (> mmr-duration 1)
3588                (not (member style '(neomensural mensural petrucci))))
3589          (let* ((mmr-stil-x-center
3590                    (interval-center (ly:stencil-extent mmr-stil X)))
3591                 (duration-markup
3592                    (markup
3593                       #:fontsize -2
3594                       #:override '(font-encoding . fetaText)
3595                       (number->string mmr-duration)))
3596                 (mmr-number-stil
3597                    (interpret-markup layout props duration-markup))
3598                 (mmr-number-stil-x-center
3599                    (interval-center (ly:stencil-extent mmr-number-stil X))))
3600
3601          (set! mmr-stil (ly:stencil-combine-at-edge
3602                            mmr-stil
3603                            Y UP
3604                            (ly:stencil-translate-axis
3605                               mmr-number-stil
3606                               (- mmr-stil-x-center mmr-number-stil-x-center)
3607                               X)
3608                            ;; Ugh, hardcoded
3609                            0.8))))
3610     (if multi-measure-rest
3611        mmr-stil
3612        stil))))
3613
3614 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3615 ;; translating.
3616 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3617
3618 (define-markup-command (lower layout props amount arg)
3619   (number? markup?)
3620   #:category align
3621   "
3622 @cindex lowering text
3623
3624 Lower @var{arg} by the distance @var{amount}.
3625 A negative @var{amount} indicates raising; see also @code{\\raise}.
3626
3627 @lilypond[verbatim,quote]
3628 \\markup {
3629   one
3630   \\lower #3
3631   two
3632   three
3633 }
3634 @end lilypond"
3635   (ly:stencil-translate-axis (interpret-markup layout props arg)
3636                              (- amount) Y))
3637
3638 (define-markup-command (translate-scaled layout props offset arg)
3639   (number-pair? markup?)
3640   #:category align
3641   #:properties ((font-size 0))
3642   "
3643 @cindex translating text
3644 @cindex scaling text
3645
3646 Translate @var{arg} by @var{offset}, scaling the offset by the
3647 @code{font-size}.
3648
3649 @lilypond[verbatim,quote]
3650 \\markup {
3651   \\fontsize #5 {
3652     * \\translate #'(2 . 3) translate
3653     \\hspace #2
3654     * \\translate-scaled #'(2 . 3) translate-scaled
3655   }
3656 }
3657 @end lilypond"
3658   (let* ((factor (magstep font-size))
3659          (scaled (cons (* factor (car offset))
3660                        (* factor (cdr offset)))))
3661     (ly:stencil-translate (interpret-markup layout props arg)
3662                           scaled)))
3663
3664 (define-markup-command (raise layout props amount arg)
3665   (number? markup?)
3666   #:category align
3667   "
3668 @cindex raising text
3669
3670 Raise @var{arg} by the distance @var{amount}.
3671 A negative @var{amount} indicates lowering, see also @code{\\lower}.
3672
3673 The argument to @code{\\raise} is the vertical displacement amount,
3674 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
3675 raise objects in relation to their surrounding markups.
3676
3677 If the text object itself is positioned above or below the staff, then
3678 @code{\\raise} cannot be used to move it, since the mechanism that
3679 positions it next to the staff cancels any shift made with
3680 @code{\\raise}.  For vertical positioning, use the @code{padding}
3681 and/or @code{extra-offset} properties.
3682
3683 @lilypond[verbatim,quote]
3684 \\markup {
3685   C
3686   \\small
3687   \\bold
3688   \\raise #1.0
3689   9/7+
3690 }
3691 @end lilypond"
3692   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
3693
3694 (define-markup-command (fraction layout props arg1 arg2)
3695   (markup? markup?)
3696   #:category other
3697   #:properties ((font-size 0))
3698   "
3699 @cindex creating text fractions
3700
3701 Make a fraction of two markups.
3702 @lilypond[verbatim,quote]
3703 \\markup {
3704   π ≈
3705   \\fraction 355 113
3706 }
3707 @end lilypond"
3708   (let* ((m1 (interpret-markup layout props arg1))
3709          (m2 (interpret-markup layout props arg2))
3710          (factor (magstep font-size))
3711          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
3712          (padding (* factor 0.2))
3713          (baseline (* factor 0.6))
3714          (offset (* factor 0.75)))
3715     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
3716     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
3717     (let* ((x1 (ly:stencil-extent m1 X))
3718            (x2 (ly:stencil-extent m2 X))
3719            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
3720            ;; should stack mols separately, to maintain LINE on baseline
3721            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
3722       (set! stack
3723             (ly:stencil-aligned-to stack Y CENTER))
3724       (set! stack
3725             (ly:stencil-aligned-to stack X LEFT))
3726       ;; should have EX dimension
3727       ;; empirical anyway
3728       (ly:stencil-translate-axis stack offset Y))))
3729
3730 (define-markup-command (normal-size-super layout props arg)
3731   (markup?)
3732   #:category font
3733   #:properties ((baseline-skip))
3734   "
3735 @cindex setting superscript in standard font size
3736
3737 Set @var{arg} in superscript with a normal font size.
3738
3739 @lilypond[verbatim,quote]
3740 \\markup {
3741   default
3742   \\normal-size-super {
3743     superscript in standard size
3744   }
3745 }
3746 @end lilypond"
3747   (ly:stencil-translate-axis
3748    (interpret-markup layout props arg)
3749    (* 0.5 baseline-skip) Y))
3750
3751 (define-markup-command (super layout props arg)
3752   (markup?)
3753   #:category font
3754   #:properties ((font-size 0)
3755                 (baseline-skip))
3756   "
3757 @cindex superscript text
3758
3759 Set @var{arg} in superscript.
3760
3761 @lilypond[verbatim,quote]
3762 \\markup {
3763   E =
3764   \\concat {
3765     mc
3766     \\super
3767     2
3768   }
3769 }
3770 @end lilypond"
3771   (ly:stencil-translate-axis
3772    (interpret-markup
3773     layout
3774     (cons `((font-size . ,(- font-size 3))) props)
3775     arg)
3776    (* 0.5 baseline-skip)
3777    Y))
3778
3779 (define-markup-command (translate layout props offset arg)
3780   (number-pair? markup?)
3781   #:category align
3782   "
3783 @cindex translating text
3784
3785 Translate @var{arg} relative to its surroundings.  @var{offset}
3786 is a pair of numbers representing the displacement in the X and Y axis.
3787
3788 @lilypond[verbatim,quote]
3789 \\markup {
3790   *
3791   \\translate #'(2 . 3)
3792   \\line { translated two spaces right, three up }
3793 }
3794 @end lilypond"
3795   (ly:stencil-translate (interpret-markup layout props arg)
3796                         offset))
3797
3798 (define-markup-command (sub layout props arg)
3799   (markup?)
3800   #:category font
3801   #:properties ((font-size 0)
3802                 (baseline-skip))
3803   "
3804 @cindex subscript text
3805
3806 Set @var{arg} in subscript.
3807
3808 @lilypond[verbatim,quote]
3809 \\markup {
3810   \\concat {
3811     H
3812     \\sub {
3813       2
3814     }
3815     O
3816   }
3817 }
3818 @end lilypond"
3819   (ly:stencil-translate-axis
3820    (interpret-markup
3821     layout
3822     (cons `((font-size . ,(- font-size 3))) props)
3823     arg)
3824    (* -0.5 baseline-skip)
3825    Y))
3826
3827 (define-markup-command (normal-size-sub layout props arg)
3828   (markup?)
3829   #:category font
3830   #:properties ((baseline-skip))
3831   "
3832 @cindex setting subscript in standard font size
3833
3834 Set @var{arg} in subscript with a normal font size.
3835
3836 @lilypond[verbatim,quote]
3837 \\markup {
3838   default
3839   \\normal-size-sub {
3840     subscript in standard size
3841   }
3842 }
3843 @end lilypond"
3844   (ly:stencil-translate-axis
3845    (interpret-markup layout props arg)
3846    (* -0.5 baseline-skip)
3847    Y))
3848
3849 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3850 ;; brackets.
3851 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3852
3853 (define-markup-command (hbracket layout props arg)
3854   (markup?)
3855   #:category graphic
3856   "
3857 @cindex placing horizontal brackets around text
3858
3859 Draw horizontal brackets around @var{arg}.
3860
3861 @lilypond[verbatim,quote]
3862 \\markup {
3863   \\hbracket {
3864     \\line {
3865       one two three
3866     }
3867   }
3868 }
3869 @end lilypond"
3870   (let ((th 0.1) ;; todo: take from GROB.
3871         (m (interpret-markup layout props arg)))
3872     (bracketify-stencil m X th (* 2.5 th) th)))
3873
3874 (define-markup-command (bracket layout props arg)
3875   (markup?)
3876   #:category graphic
3877   "
3878 @cindex placing vertical brackets around text
3879
3880 Draw vertical brackets around @var{arg}.
3881
3882 @lilypond[verbatim,quote]
3883 \\markup {
3884   \\bracket {
3885     \\note #\"2.\" #UP
3886   }
3887 }
3888 @end lilypond"
3889   (let ((th 0.1) ;; todo: take from GROB.
3890         (m (interpret-markup layout props arg)))
3891     (bracketify-stencil m Y th (* 2.5 th) th)))
3892
3893 (define-markup-command (parenthesize layout props arg)
3894   (markup?)
3895   #:category graphic
3896   #:properties ((angularity 0)
3897                 (padding)
3898                 (size 1)
3899                 (thickness 1)
3900                 (width 0.25))
3901   "
3902 @cindex placing parentheses around text
3903
3904 Draw parentheses around @var{arg}.  This is useful for parenthesizing
3905 a column containing several lines of text.
3906
3907 @lilypond[verbatim,quote]
3908 \\markup {
3909   \\line {
3910     \\parenthesize {
3911       \\column {
3912         foo
3913         bar
3914       }
3915     }
3916     \\override #'(angularity . 2) {
3917       \\parenthesize {
3918         \\column {
3919           bah
3920           baz
3921         }
3922       }
3923     }
3924   }
3925 }
3926 @end lilypond"
3927   (let* ((markup (interpret-markup layout props arg))
3928          (scaled-width (* size width))
3929          (scaled-thickness
3930           (* (chain-assoc-get 'line-thickness props 0.1)
3931              thickness))
3932          (half-thickness
3933           (min (* size 0.5 scaled-thickness)
3934                (* (/ 4 3.0) scaled-width)))
3935          (padding (chain-assoc-get 'padding props half-thickness)))
3936     (parenthesize-stencil
3937      markup half-thickness scaled-width angularity padding)))
3938
3939
3940 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3941 ;; Delayed markup evaluation
3942 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3943
3944 (define-markup-command (page-ref layout props label gauge default)
3945   (symbol? markup? markup?)
3946   #:category other
3947   "
3948 @cindex referencing page numbers in text
3949
3950 Reference to a page number.  @var{label} is the label set on the referenced
3951 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
3952 the maximum width of the page number, and @var{default} the value to display
3953 when @var{label} is not found."
3954   (let* ((gauge-stencil (interpret-markup layout props gauge))
3955          (x-ext (ly:stencil-extent gauge-stencil X))
3956          (y-ext (ly:stencil-extent gauge-stencil Y)))
3957     (ly:make-stencil
3958      `(delay-stencil-evaluation
3959        ,(delay (ly:stencil-expr
3960                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
3961                        (page-number (if (list? table)
3962                                         (assoc-get label table)
3963                                         #f))
3964                        (page-markup (if page-number (format #f "~a" page-number) default))
3965                        (page-stencil (interpret-markup layout props page-markup))
3966                        (gap (- (interval-length x-ext)
3967                                (interval-length (ly:stencil-extent page-stencil X)))))
3968                   (interpret-markup layout props
3969                                     (markup #:concat (#:hspace gap page-markup)))))))
3970      x-ext
3971      y-ext)))
3972
3973 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3974 ;; scaling
3975 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3976
3977 (define-markup-command (scale layout props factor-pair arg)
3978   (number-pair? markup?)
3979   #:category graphic
3980   "
3981 @cindex scaling markup
3982 @cindex mirroring markup
3983
3984 Scale @var{arg}.  @var{factor-pair} is a pair of numbers
3985 representing the scaling-factor in the X and Y axes.
3986 Negative values may be used to produce mirror images.
3987
3988 @lilypond[verbatim,quote]
3989 \\markup {
3990   \\line {
3991     \\scale #'(2 . 1)
3992     stretched
3993     \\scale #'(1 . -1)
3994     mirrored
3995   }
3996 }
3997 @end lilypond"
3998   (let ((stil (interpret-markup layout props arg))
3999         (sx (car factor-pair))
4000         (sy (cdr factor-pair)))
4001     (ly:stencil-scale stil sx sy)))
4002
4003 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4004 ;; Repeating
4005 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4006
4007 (define-markup-command (pattern layout props count axis space pattern)
4008   (integer? integer? number? markup?)
4009   #:category other
4010   "
4011 Prints @var{count} times a @var{pattern} markup.
4012 Patterns are spaced apart by @var{space}.
4013 Patterns are distributed on @var{axis}.
4014
4015 @lilypond[verbatim, quote]
4016 \\markup \\column {
4017   \"Horizontally repeated :\"
4018   \\pattern #7 #X #2 \\flat
4019   \\null
4020   \"Vertically repeated :\"
4021   \\pattern #3 #Y #0.5 \\flat
4022 }
4023 @end lilypond"
4024   (let ((pattern-width (interval-length
4025                          (ly:stencil-extent (interpret-markup layout props pattern) X)))
4026         (new-props (prepend-alist-chain 'word-space 0 (prepend-alist-chain 'baseline-skip 0 props))))
4027     (let loop ((i (1- count)) (patterns (markup)))
4028       (if (zero? i)
4029           (interpret-markup
4030             layout
4031             new-props
4032             (if (= axis X)
4033                 (markup patterns pattern)
4034                 (markup #:column (patterns pattern))))
4035           (loop (1- i)
4036             (if (= axis X)
4037                 (markup patterns pattern #:hspace space)
4038                 (markup #:column (patterns pattern #:vspace space))))))))
4039
4040 (define-markup-command (fill-with-pattern layout props space dir pattern left right)
4041   (number? ly:dir? markup? markup? markup?)
4042   #:category align
4043   #:properties ((word-space)
4044                 (line-width))
4045   "
4046 Put @var{left} and @var{right} in a horizontal line of width @code{line-width}
4047 with a line of markups @var{pattern} in between.
4048 Patterns are spaced apart by @var{space}.
4049 Patterns are aligned to the @var{dir} markup.
4050
4051 @lilypond[verbatim, quote]
4052 \\markup \\column {
4053   \"right-aligned :\"
4054   \\fill-with-pattern #1 #RIGHT . first right
4055   \\fill-with-pattern #1 #RIGHT . second right
4056   \\null
4057   \"center-aligned :\"
4058   \\fill-with-pattern #1.5 #CENTER - left right
4059   \\null
4060   \"left-aligned :\"
4061   \\override #'(line-width . 50)
4062   \\fill-with-pattern #2 #LEFT : left first
4063   \\override #'(line-width . 50)
4064   \\fill-with-pattern #2 #LEFT : left second
4065 }
4066 @end lilypond"
4067   (let* ((pattern-x-extent (ly:stencil-extent (interpret-markup layout props pattern) X))
4068          (pattern-width (interval-length pattern-x-extent))
4069          (left-width (interval-length (ly:stencil-extent (interpret-markup layout props left) X)))
4070          (right-width (interval-length (ly:stencil-extent (interpret-markup layout props right) X)))
4071          (middle-width (max 0 (- line-width (+ (+ left-width right-width) (* word-space 2)))))
4072          (period (+ space pattern-width))
4073          (count (truncate (/ (- middle-width pattern-width) period)))
4074          (x-offset (+ (* (- (- middle-width (* count period)) pattern-width) (/ (1+ dir) 2)) (abs (car pattern-x-extent)))))
4075     (interpret-markup layout props
4076                       (markup left
4077                               #:with-dimensions (cons 0 middle-width) '(0 . 0)
4078                               #:translate (cons x-offset 0)
4079                               #:pattern (1+ count) X space pattern
4080                               right))))
4081
4082 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4083 ;; Replacements
4084 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4085
4086 (define-markup-command (replace layout props replacements arg)
4087   (list? markup?)
4088   #:category font
4089   "
4090 Used to automatically replace a string by another in the markup @var{arg}.
4091 Each pair of the alist @var{replacements} specifies what should be replaced.
4092 The @code{key} is the string to be replaced by the @code{value} string.
4093
4094 @lilypond[verbatim, quote]
4095 \\markup \\replace #'((\"thx\" . \"Thanks!\")) thx
4096 @end lilypond"
4097   (interpret-markup
4098    layout
4099    (internal-add-text-replacements
4100     props
4101     replacements)
4102    (markup arg)))
4103
4104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4105 ;; Markup list commands
4106 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4107
4108 (define-public (space-lines baseline stils)
4109   (let space-stil ((stils stils)
4110                    (result (list)))
4111     (if (null? stils)
4112         (reverse! result)
4113         (let* ((stil (car stils))
4114                (dy-top (max (- (/ baseline 1.5)
4115                                (interval-bound (ly:stencil-extent stil Y) UP))
4116                             0.0))
4117                (dy-bottom (max (+ (/ baseline 3.0)
4118                                   (interval-bound (ly:stencil-extent stil Y) DOWN))
4119                                0.0))
4120                (new-stil (ly:make-stencil
4121                           (ly:stencil-expr stil)
4122                           (ly:stencil-extent stil X)
4123                           (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
4124                                    dy-bottom)
4125                                 (+ (interval-bound (ly:stencil-extent stil Y) UP)
4126                                    dy-top)))))
4127           (space-stil (cdr stils) (cons new-stil result))))))
4128
4129 (define-markup-list-command (justified-lines layout props args)
4130   (markup-list?)
4131   #:properties ((baseline-skip)
4132                 wordwrap-internal-markup-list)
4133   "
4134 @cindex justifying lines of text
4135
4136 Like @code{\\justify}, but return a list of lines instead of a single markup.
4137 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
4138 @var{X}@tie{}is the number of staff spaces."
4139   (space-lines baseline-skip
4140                (interpret-markup-list layout props
4141                                       (make-wordwrap-internal-markup-list #t args))))
4142
4143 (define-markup-list-command (wordwrap-lines layout props args)
4144   (markup-list?)
4145   #:properties ((baseline-skip)
4146                 wordwrap-internal-markup-list)
4147   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
4148 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
4149 where @var{X} is the number of staff spaces."
4150   (space-lines baseline-skip
4151                (interpret-markup-list layout props
4152                                       (make-wordwrap-internal-markup-list #f args))))
4153
4154 (define-markup-list-command (column-lines layout props args)
4155   (markup-list?)
4156   #:properties ((baseline-skip))
4157   "Like @code{\\column}, but return a list of lines instead of a single markup.
4158 @code{baseline-skip} determines the space between each markup in @var{args}."
4159   (space-lines baseline-skip
4160                (interpret-markup-list layout props args)))
4161
4162 (define-markup-list-command (override-lines layout props new-prop args)
4163   (pair? markup-list?)
4164   "Like @code{\\override}, for markup lists."
4165   (interpret-markup-list layout (cons (list new-prop) props) args))