scm/define-markup-commands.scm

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