scm/define-markup-commands.scm

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