scm/define-markup-commands.scm

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