scm/define-markup-commands.scm

   1 ;;;; define-markup-commands.scm -- markup commands
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2000--2007  Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8
   9 ;;; markup commands
  10 ;;;  * each markup function should have a doc string with
  11 ;;     syntax, description and example.
  12
  13 (use-modules (ice-9 regex))
  14
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;; utility functions
  17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18
  19 (define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
  20 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
  21
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;; geometric shapes
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25
  26 (define-builtin-markup-command (draw-line layout props dest)
  27   (number-pair?)
  28   graphic
  29   ((thickness 1))
  30   "
  31 @cindex drawing lines within text
  32
  33 A simple line."
  34   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
  35                thickness))
  36         (x (car dest))
  37         (y (cdr dest)))
  38     (ly:make-stencil
  39      `(draw-line
  40        ,th
  41        0 0
  42        ,x ,y)
  43      (cons (min x 0) (max x 0))
  44      (cons (min y 0) (max y 0)))))
  45
  46 (define-builtin-markup-command (draw-circle layout props radius thickness fill)
  47   (number? number? boolean?)
  48   graphic
  49   ()
  50   "
  51 @cindex drawing circles within text
  52
  53 A circle of radius @var{radius}, thickness @var{thickness} and
  54 optionally filled.
  55 @c
  56 @lilypond[verbatim,quote]
  57 \\markup { \\draw-circle #2 #0.5 ##f \\hspace #2 \\draw-circle #2 #0 ##t }
  58 @end lilypond"
  59   (make-circle-stencil radius thickness fill))
  60
  61 (define-builtin-markup-command (triangle layout props filled)
  62   (boolean?)
  63   graphic
  64   ((thickness 0.1)
  65    (font-size 0)
  66    (baseline-skip 2))
  67   "
  68 @cindex drawing triangles within text
  69
  70 A triangle, either filled or empty.
  71 @c
  72 @lilypond[verbatim,quote]
  73 \\markup { \\triangle ##f \\triangle ##t }
  74 @end lilypond"
  75   (let ((ex (* (magstep font-size) 0.8 baseline-skip)))
  76     (ly:make-stencil
  77      `(polygon '(0.0 0.0
  78                      ,ex 0.0
  79                      ,(* 0.5 ex)
  80                      ,(* 0.86 ex))
  81            ,thickness
  82            ,filled)
  83      (cons 0 ex)
  84      (cons 0 (* .86 ex)))))
  85
  86 (define-builtin-markup-command (circle layout props arg)
  87   (markup?)
  88   graphic
  89   ((thickness 1)
  90    (font-size 0)
  91    (circle-padding 0.2))
  92   "
  93 @cindex circling text
  94
  95 Draw a circle around @var{arg}.  Use @code{thickness},
  96 @code{circle-padding} and @code{font-size} properties to determine line
  97 thickness and padding around the markup."
  98   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
  99                thickness))
 100          (pad (* (magstep font-size) circle-padding))
 101          (m (interpret-markup layout props arg)))
 102     (circle-stencil m th pad)))
 103
 104 (define-builtin-markup-command (with-url layout props url arg)
 105   (string? markup?)
 106   graphic
 107   ()
 108   "
 109 @cindex inserting URL links into text
 110
 111 Add a link to URL @var{url} around @var{arg}.  This only works in
 112 the PDF backend.
 113 @lilypond[verbatim,quote]
 114 \\markup {
 115   \\with-url #\"http://lilypond.org/web/\" {
 116     LilyPond ... \\italic \"music notation for everyone\"
 117   }
 118 }
 119 @end lilypond"
 120   (let* ((stil (interpret-markup layout props arg))
 121          (xextent (ly:stencil-extent stil X))
 122          (yextent (ly:stencil-extent stil Y))
 123          (old-expr (ly:stencil-expr stil))
 124          (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
 125
 126     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
 127
 128 (define-builtin-markup-command (beam layout props width slope thickness)
 129   (number? number? number?)
 130   graphic
 131   ()
 132   "
 133 @cindex drawing beams within text
 134
 135 Create a beam with the specified parameters."
 136   (let* ((y (* slope width))
 137          (yext (cons (min 0 y) (max 0 y)))
 138          (half (/ thickness 2)))
 139
 140     (ly:make-stencil
 141      `(polygon ',(list
 142                   0 (/ thickness -2)
 143                     width (+ (* width slope)  (/ thickness -2))
 144                     width (+ (* width slope)  (/ thickness 2))
 145                     0 (/ thickness 2))
 146                ,(ly:output-def-lookup layout 'blot-diameter)
 147                #t)
 148      (cons 0 width)
 149      (cons (+ (- half) (car yext))
 150            (+ half (cdr yext))))))
 151
 152 (define-builtin-markup-command (underline layout props arg)
 153   (markup?)
 154   music
 155   ((thickness 1))
 156   "
 157 @cindex underlining text
 158
 159 Underline @var{arg}.  Looks at @code{thickness} to determine line
 160 thickness and y offset."
 161   (let* ((thick (* (ly:output-def-lookup layout 'line-thickness)
 162                    thickness))
 163          (markup (interpret-markup layout props arg))
 164          (x1 (car (ly:stencil-extent markup X)))
 165          (x2 (cdr (ly:stencil-extent markup X)))
 166          (y (* thick -2))
 167          (line (ly:make-stencil
 168                 `(draw-line ,thick ,x1 ,y ,x2 ,y)
 169                 (cons (min x1 0) (max x2 0))
 170                 (cons thick thick))))
 171     (ly:stencil-add markup line)))
 172
 173 (define-builtin-markup-command (box layout props arg)
 174   (markup?)
 175   font
 176   ((thickness 1)
 177    (font-size 0)
 178    (box-padding 0.2))
 179   "
 180 @cindex enclosing text within a box
 181
 182 Draw a box round @var{arg}.  Looks at @code{thickness},
 183 @code{box-padding} and @code{font-size} properties to determine line
 184 thickness and padding around the markup."
 185   (let* ((th (* (ly:output-def-lookup layout 'line-thickness)
 186                 thickness))
 187          (pad (* (magstep font-size) box-padding))
 188          (m (interpret-markup layout props arg)))
 189     (box-stencil m th pad)))
 190
 191 (define-builtin-markup-command (filled-box layout props xext yext blot)
 192   (number-pair? number-pair? number?)
 193   graphic
 194   ()
 195   "
 196 @cindex drawing solid boxes within text
 197 @cindex drawing boxes with rounded corners
 198
 199 Draw a box with rounded corners of dimensions @var{xext} and
 200 @var{yext}.  For example,
 201 @verbatim
 202 \\filled-box #'(-.3 . 1.8) #'(-.3 . 1.8) #0
 203 @end verbatim
 204 creates a box extending horizontally from -0.3 to 1.8 and
 205 vertically from -0.3 up to 1.8, with corners formed from a
 206 circle of diameter@tie{}0 (i.e. sharp corners)."
 207   (ly:round-filled-box
 208    xext yext blot))
 209
 210 (define-builtin-markup-command (rounded-box layout props arg)
 211   (markup?)
 212   graphic
 213   ((thickness 1)
 214    (corner-radius 1)
 215    (font-size 0)
 216    (box-padding 0.5))
 217   "@cindex enclosing text in a bow with rounded corners
 218    @cindex drawing boxes with rounded corners around text
 219 Draw a box with rounded corners around @var{arg}.  Looks at @code{thickness},
 220 @code{box-padding} and @code{font-size} properties to determine line
 221 thickness and padding around the markup; the @code{corner-radius} property
 222 makes possible to define another shape for the corners (default is 1).
 223
 224 @lilypond[quote,verbatim,fragment,relative=2]
 225 c^\\markup{ \\rounded-box Overtura }
 226 c,8. c16 c4 r
 227 @end lilypond"
 228   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
 229                thickness))
 230         (pad (* (magstep font-size) box-padding))
 231         (m (interpret-markup layout props arg)))
 232     (ly:stencil-add (rounded-box-stencil m th pad corner-radius)
 233                     m)))
 234
 235 (define-builtin-markup-command (rotate layout props ang arg)
 236   (number? markup?)
 237   align
 238   ()
 239   "
 240 @cindex rotating text
 241
 242 Rotate object with @var{ang} degrees around its center."
 243   (let* ((stil (interpret-markup layout props arg)))
 244     (ly:stencil-rotate stil ang 0 0)))
 245
 246 (define-builtin-markup-command (whiteout layout props arg)
 247   (markup?)
 248   other
 249   ()
 250   "
 251 @cindex adding a white background to text
 252
 253 Provide a white background for @var{arg}."
 254   (stencil-whiteout (interpret-markup layout props arg)))
 255
 256 (define-builtin-markup-command (pad-markup layout props padding arg)
 257   (number? markup?)
 258   align
 259   ()
 260   "
 261 @cindex padding text
 262 @cindex putting space around text
 263
 264 Add space around a markup object."
 265   (let*
 266       ((stil (interpret-markup layout props arg))
 267        (xext (ly:stencil-extent stil X))
 268        (yext (ly:stencil-extent stil Y)))
 269
 270     (ly:make-stencil
 271      (ly:stencil-expr stil)
 272      (interval-widen xext padding)
 273      (interval-widen yext padding))))
 274
 275 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 276 ;; space
 277 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 278
 279 (define-builtin-markup-command (strut layout props)
 280   ()
 281   other
 282   ()
 283   "
 284 @cindex creating vertical spaces in text
 285
 286 Create a box of the same height as the space in the current font."
 287   (let ((m (ly:text-interface::interpret-markup layout props " ")))
 288     (ly:make-stencil (ly:stencil-expr m)
 289                      '(0 . 0)
 290                      (ly:stencil-extent m X)
 291                      )))
 292
 293 ;; todo: fix negative space
 294 (define-builtin-markup-command (hspace layout props amount)
 295   (number?)
 296   align
 297   ()
 298   "
 299 @cindex creating horizontal spaces in text
 300
 301 This produces a invisible object taking horizontal space.  For example,
 302
 303 @example
 304 \\markup @{ A \\hspace #2.0 B @}
 305 @end example
 306
 307 @noindent
 308 puts extra space between A and@tie{}B, on top of the space that is
 309 normally inserted before elements on a line."
 310   (if (> amount 0)
 311       (ly:make-stencil "" (cons 0 amount) '(-1 . 1))
 312       (ly:make-stencil "" (cons amount amount) '(-1 . 1))))
 313
 314
 315 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 316 ;; importing graphics.
 317 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 318
 319 (define-builtin-markup-command (stencil layout props stil)
 320   (ly:stencil?)
 321   other
 322   ()
 323   "
 324 @cindex importing stencils into text
 325
 326 Use a stencil as markup."
 327   stil)
 328
 329 (define bbox-regexp
 330   (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
 331
 332 (define (get-postscript-bbox string)
 333   "Extract the bbox from STRING, or return #f if not present."
 334   (let*
 335       ((match (regexp-exec bbox-regexp string)))
 336
 337     (if match
 338         (map (lambda (x)
 339                (string->number (match:substring match x)))
 340              (cdr (iota 5)))
 341
 342         #f)))
 343
 344 (define-builtin-markup-command (epsfile layout props axis size file-name)
 345   (number? number? string?)
 346   graphic
 347   ()
 348   "
 349 @cindex inlining an Encapsulated PostScript image
 350
 351 Inline an EPS image.  The image is scaled along @var{axis} to
 352 @var{size}."
 353   (if (ly:get-option 'safe)
 354       (interpret-markup layout props "not allowed in safe")
 355       (eps-file->stencil axis size file-name)
 356       ))
 357
 358 (define-builtin-markup-command (postscript layout props str)
 359   (string?)
 360   graphic
 361   ()
 362   "
 363 @cindex inserting PostScript directly into text
 364
 365 This inserts @var{str} directly into the output as a PostScript
 366 command string.  Due to technicalities of the output backends,
 367 different scales should be used for the @TeX{} and PostScript backend,
 368 selected with @code{-f}.
 369
 370 For the @TeX{} backend, the following string prints a rotated text
 371
 372 @example
 373 0 0 moveto /ecrm10 findfont
 374 1.75 scalefont setfont 90 rotate (hello) show
 375 @end example
 376
 377 @noindent
 378 The magical constant 1.75 scales from LilyPond units (staff spaces) to
 379 @TeX{} dimensions.
 380
 381 For the postscript backend, use the following
 382
 383 @example
 384 gsave /ecrm10 findfont
 385  10.0 output-scale div
 386  scalefont setfont 90 rotate (hello) show grestore
 387 @end example"
 388   ;; FIXME
 389   (ly:make-stencil
 390    (list 'embedded-ps
 391          (format "
 392 gsave currentpoint translate
 393 0.1 setlinewidth
 394  ~a
 395 grestore
 396 "
 397                  str))
 398    '(0 . 0) '(0 . 0)))
 399
 400 (define-builtin-markup-command (score layout props score)
 401   (ly:score?)
 402   music
 403   ()
 404   "
 405 @cindex inserting music into text
 406
 407 Inline an image of music."
 408   (let* ((output (ly:score-embedded-format score layout)))
 409
 410     (if (ly:music-output? output)
 411         (paper-system-stencil
 412          (vector-ref (ly:paper-score-paper-systems output) 0))
 413         (begin
 414           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
 415           empty-stencil))))
 416
 417 (define-builtin-markup-command (null layout props)
 418   ()
 419   other
 420   ()
 421   "
 422 @cindex creating empty text objects
 423
 424 An empty markup with extents of a single point."
 425   point-stencil)
 426
 427 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 428 ;; basic formatting.
 429 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 430
 431 (define-builtin-markup-command (simple layout props str)
 432   (string?)
 433   font
 434   ()
 435   "
 436 @cindex simple text strings
 437
 438 A simple text string; @code{\\markup @{ foo @}} is equivalent with
 439 @code{\\markup @{ \\simple #\"foo\" @}}."
 440   (interpret-markup layout props str))
 441
 442 (define-builtin-markup-command (tied-lyric layout props str)
 443   (string?)
 444   music
 445   ()
 446   "
 447 @cindex simple text strings with tie characters
 448
 449 Like simple-markup, but use tie characters for @q{~} tilde symbols."
 450   (if (string-contains str "~")
 451       (let*
 452           ((parts (string-split str #\~))
 453            (tie-str (ly:wide-char->utf-8 #x203f))
 454            (joined  (list-join parts tie-str))
 455            (join-stencil (interpret-markup layout props tie-str))
 456            )
 457
 458         (interpret-markup layout
 459                           (prepend-alist-chain
 460                            'word-space
 461                            (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
 462                            props)
 463                           (make-line-markup joined)))
 464                            ;(map (lambda (s) (interpret-markup layout props s)) parts))
 465       (interpret-markup layout props str)))
 466
 467 (define-public empty-markup
 468   (make-simple-markup ""))
 469
 470 ;; helper for justifying lines.
 471 (define (get-fill-space word-count line-width text-widths)
 472   "Calculate the necessary paddings between each two adjacent texts.
 473         The lengths of all texts are stored in @var{text-widths}.
 474         The normal formula for the padding between texts a and b is:
 475         padding = line-width/(word-count - 1) - (length(a) + length(b))/2
 476         The first and last padding have to be calculated specially using the
 477         whole length of the first or last text.
 478         Return a list of paddings."
 479   (cond
 480    ((null? text-widths) '())
 481
 482    ;; special case first padding
 483    ((= (length text-widths) word-count)
 484     (cons
 485      (- (- (/ line-width (1- word-count)) (car text-widths))
 486         (/ (car (cdr text-widths)) 2))
 487      (get-fill-space word-count line-width (cdr text-widths))))
 488    ;; special case last padding
 489    ((= (length text-widths) 2)
 490     (list (- (/ line-width (1- word-count))
 491              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
 492    (else
 493     (cons
 494      (- (/ line-width (1- word-count))
 495         (/ (+ (car text-widths) (car (cdr text-widths))) 2))
 496      (get-fill-space word-count line-width (cdr text-widths))))))
 497
 498 (define-builtin-markup-command (fill-line layout props markups)
 499   (markup-list?)
 500   align
 501   ((text-direction RIGHT)
 502    (word-space 1)
 503    (line-width #f))
 504   "Put @var{markups} in a horizontal line of width @var{line-width}.
 505 The markups are spaced or flushed to fill the entire line.
 506 If there are no arguments, return an empty stencil."
 507
 508   (let* ((orig-stencils (interpret-markup-list layout props markups))
 509          (stencils
 510           (map (lambda (stc)
 511                  (if (ly:stencil-empty? stc)
 512                      point-stencil
 513                      stc)) orig-stencils))
 514          (text-widths
 515           (map (lambda (stc)
 516                  (if (ly:stencil-empty? stc)
 517                      0.0
 518                      (interval-length (ly:stencil-extent stc X))))
 519                stencils))
 520          (text-width (apply + text-widths))
 521          (word-count (length stencils))
 522          (prop-line-width (chain-assoc-get 'line-width props #f))
 523          (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
 524          (fill-space
 525                 (cond
 526                         ((= word-count 1)
 527                                 (list
 528                                         (/ (- line-width text-width) 2)
 529                                         (/ (- line-width text-width) 2)))
 530                         ((= word-count 2)
 531                                 (list
 532                                         (- line-width text-width)))
 533                         (else
 534                                 (get-fill-space word-count line-width text-widths))))
 535          (fill-space-normal
 536           (map (lambda (x)
 537                  (if (< x word-space)
 538                      word-space
 539                      x))
 540                fill-space))
 541
 542          (line-stencils (if (= word-count 1)
 543                             (list
 544                              point-stencil
 545                              (car stencils)
 546                              point-stencil)
 547                             stencils)))
 548
 549     (if (= text-direction LEFT)
 550         (set! line-stencils (reverse line-stencils)))
 551
 552     (if (null? (remove ly:stencil-empty? orig-stencils))
 553         empty-stencil
 554         (stack-stencils-padding-list X
 555                                      RIGHT fill-space-normal line-stencils))))
 556
 557 (define-builtin-markup-command (line layout props args)
 558   (markup-list?)
 559   align
 560   ((word-space)
 561    (text-direction RIGHT))
 562   "Put @var{args} in a horizontal line.  The property @code{word-space}
 563 determines the space between each markup in @var{args}."
 564   (let ((stencils (interpret-markup-list layout props args)))
 565     (if (= text-direction LEFT)
 566         (set! stencils (reverse stencils)))
 567     (stack-stencil-line
 568      word-space
 569      (remove ly:stencil-empty? stencils))))
 570
 571 (define-builtin-markup-command (concat layout props args)
 572   (markup-list?)
 573   align
 574   ()
 575   "
 576 @cindex concatenating text
 577 @cindex ligatures in text
 578
 579 Concatenate @var{args} in a horizontal line, without spaces inbetween.
 580 Strings and simple markups are concatenated on the input level, allowing
 581 ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
 582 equivalent to @code{\"fi\"}."
 583   (define (concat-string-args arg-list)
 584     (fold-right (lambda (arg result-list)
 585                   (let ((result (if (pair? result-list)
 586                                     (car result-list)
 587                                   '())))
 588                     (if (and (pair? arg) (eqv? (car arg) simple-markup))
 589                       (set! arg (cadr arg)))
 590                     (if (and (string? result) (string? arg))
 591                         (cons (string-append arg result) (cdr result-list))
 592                       (cons arg result-list))))
 593                 '()
 594                 arg-list))
 595
 596   (interpret-markup layout
 597                     (prepend-alist-chain 'word-space 0 props)
 598                     (make-line-markup (if (markup-command-list? args)
 599                                           args
 600                                           (concat-string-args args)))))
 601
 602 (define (wordwrap-stencils stencils
 603                            justify base-space line-width text-dir)
 604   "Perform simple wordwrap, return stencil of each line."
 605   (define space (if justify
 606                     ;; justify only stretches lines.
 607                     (* 0.7 base-space)
 608                     base-space))
 609   (define (take-list width space stencils
 610                      accumulator accumulated-width)
 611     "Return (head-list . tail) pair, with head-list fitting into width"
 612     (if (null? stencils)
 613         (cons accumulator stencils)
 614         (let* ((first (car stencils))
 615                (first-wid (cdr (ly:stencil-extent (car stencils) X)))
 616                (newwid (+ space first-wid accumulated-width)))
 617           (if (or (null? accumulator)
 618                   (< newwid width))
 619               (take-list width space
 620                          (cdr stencils)
 621                          (cons first accumulator)
 622                          newwid)
 623               (cons accumulator stencils)))))
 624   (let loop ((lines '())
 625              (todo stencils))
 626     (let* ((line-break (take-list line-width space todo
 627                                   '() 0.0))
 628            (line-stencils (car line-break))
 629            (space-left (- line-width
 630                           (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
 631                                         line-stencils))))
 632            (line-word-space (cond ((not justify) space)
 633                                   ;; don't stretch last line of paragraph.
 634                                   ;; hmmm . bug - will overstretch the last line in some case.
 635                                   ((null? (cdr line-break))
 636                                    base-space)
 637                                   ((null? line-stencils) 0.0)
 638                                   ((null? (cdr line-stencils)) 0.0)
 639                                   (else (/ space-left (1- (length line-stencils))))))
 640            (line (stack-stencil-line line-word-space
 641                                      (if (= text-dir RIGHT)
 642                                          (reverse line-stencils)
 643                                          line-stencils))))
 644       (if (pair? (cdr line-break))
 645           (loop (cons line lines)
 646                 (cdr line-break))
 647           (begin
 648             (if (= text-dir LEFT)
 649                 (set! line
 650                       (ly:stencil-translate-axis
 651                        line
 652                        (- line-width (interval-end (ly:stencil-extent line X)))
 653                        X)))
 654             (reverse (cons line lines)))))))
 655
 656 (define-builtin-markup-list-command (wordwrap-internal layout props justify args)
 657   (boolean? markup-list?)
 658   ((line-width #f)
 659    (word-space)
 660    (text-direction RIGHT))
 661   "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
 662   (wordwrap-stencils (remove ly:stencil-empty?
 663                              (interpret-markup-list layout props args))
 664                      justify
 665                      word-space
 666                      (or line-width
 667                          (ly:output-def-lookup layout 'line-width))
 668                      text-direction))
 669
 670 (define-builtin-markup-command (justify layout props args)
 671   (markup-list?)
 672   align
 673   ((baseline-skip)
 674    wordwrap-internal-markup-list)
 675   "
 676 @cindex justifying text
 677
 678 Like wordwrap, but with lines stretched to justify the margins.
 679 Use @code{\\override #'(line-width . @var{X})} to set the line width;
 680 @var{X}@tie{}is the number of staff spaces."
 681   (stack-lines DOWN 0.0 baseline-skip
 682                (wordwrap-internal-markup-list layout props #t args)))
 683
 684 (define-builtin-markup-command (wordwrap layout props args)
 685   (markup-list?)
 686   align
 687   ((baseline-skip)
 688    wordwrap-internal-markup-list)
 689   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
 690 the line width, where @var{X} is the number of staff spaces."
 691   (stack-lines DOWN 0.0 baseline-skip
 692                (wordwrap-internal-markup-list layout props #f args)))
 693
 694 (define-builtin-markup-list-command (wordwrap-string-internal layout props justify arg)
 695   (boolean? string?)
 696   ((line-width)
 697    (word-space)
 698    (text-direction RIGHT))
 699   "Internal markup list command used to define @code{\\justify-string} and
 700 @code{\\wordwrap-string}."
 701   (let* ((para-strings (regexp-split
 702                         (string-regexp-substitute
 703                          "\r" "\n"
 704                          (string-regexp-substitute "\r\n" "\n" arg))
 705                         "\n[ \t\n]*\n[ \t\n]*"))
 706          (list-para-words (map (lambda (str)
 707                                  (regexp-split str "[ \t\n]+"))
 708                                para-strings))
 709          (para-lines (map (lambda (words)
 710                             (let* ((stencils
 711                                     (remove ly:stencil-empty?
 712                                             (map (lambda (x)
 713                                                    (interpret-markup layout props x))
 714                                                  words))))
 715                               (wordwrap-stencils stencils
 716                                                  justify word-space
 717                                                  line-width text-direction)))
 718                           list-para-words)))
 719     (apply append para-lines)))
 720
 721 (define-builtin-markup-command (wordwrap-string layout props arg)
 722   (string?)
 723   align
 724   ((baseline-skip)
 725    wordwrap-string-internal-markup-list)
 726   "Wordwrap a string.  Paragraphs may be separated with double newlines."
 727   (stack-lines DOWN 0.0 baseline-skip
 728                (wordwrap-string-internal-markup-list layout props #f arg)))
 729
 730 (define-builtin-markup-command (justify-string layout props arg)
 731   (string?)
 732   align
 733   ((baseline-skip)
 734    wordwrap-string-internal-markup-list)
 735   "Justify a string.  Paragraphs may be separated with double newlines"
 736   (stack-lines DOWN 0.0 baseline-skip
 737                (wordwrap-string-internal-markup-list layout props #t arg)))
 738
 739 (define-builtin-markup-command (wordwrap-field layout props symbol)
 740   (symbol?)
 741   align
 742   ()
 743   "Wordwrap the data which has been assigned to @var{symbol}."
 744   (let* ((m (chain-assoc-get symbol props)))
 745     (if (string? m)
 746         (wordwrap-string-markup layout props m)
 747         empty-stencil)))
 748
 749 (define-builtin-markup-command (justify-field layout props symbol)
 750   (symbol?)
 751   align
 752   ()
 753   "Justify the data which has been assigned to @var{symbol}."
 754   (let* ((m (chain-assoc-get symbol props)))
 755     (if (string? m)
 756         (justify-string-markup layout props m)
 757         empty-stencil)))
 758
 759 (define-builtin-markup-command (combine layout props m1 m2)
 760   (markup? markup?)
 761   align
 762   ()
 763   "
 764 @cindex merging text
 765
 766 Print two markups on top of each other."
 767   (let* ((s1 (interpret-markup layout props m1))
 768          (s2 (interpret-markup layout props m2)))
 769     (ly:stencil-add s1 s2)))
 770
 771 ;;
 772 ;; TODO: should extract baseline-skip from each argument somehow..
 773 ;;
 774 (define-builtin-markup-command (column layout props args)
 775   (markup-list?)
 776   align
 777   ((baseline-skip))
 778   "
 779 @cindex stacking text in a column
 780
 781 Stack the markups in @var{args} vertically.  The property
 782 @code{baseline-skip} determines the space between each markup in @var{args}."
 783   (let ((arg-stencils (interpret-markup-list layout props args)))
 784     (stack-lines -1 0.0 baseline-skip
 785                  (remove ly:stencil-empty? arg-stencils))))
 786
 787 (define-builtin-markup-command (dir-column layout props args)
 788   (markup-list?)
 789   align
 790   ((direction)
 791    (baseline-skip))
 792   "
 793 @cindex changing direction of text columns
 794
 795 Make a column of args, going up or down, depending on the setting
 796 of the @code{#'direction} layout property."
 797   (stack-lines (if (number? direction) direction -1)
 798                0.0
 799                baseline-skip
 800                (interpret-markup-list layout props args)))
 801
 802 (define-builtin-markup-command (center-align layout props args)
 803   (markup-list?)
 804   align
 805   ((baseline-skip))
 806   "
 807 @cindex centering a column of text
 808
 809 Put @code{args} in a centered column."
 810   (let* ((mols (interpret-markup-list layout props args))
 811          (cmols (map (lambda (x) (ly:stencil-aligned-to x X CENTER)) mols)))
 812     (stack-lines -1 0.0 baseline-skip cmols)))
 813
 814 (define-builtin-markup-command (vcenter layout props arg)
 815   (markup?)
 816   align
 817   ()
 818   "
 819 @cindex vertically centering text
 820
 821 Align @code{arg} to its Y@tie{}center."
 822   (let* ((mol (interpret-markup layout props arg)))
 823     (ly:stencil-aligned-to mol Y CENTER)))
 824
 825 (define-builtin-markup-command (hcenter layout props arg)
 826   (markup?)
 827   align
 828   ()
 829   "
 830 @cindex horizontally centering text
 831
 832 Align @code{arg} to its X@tie{}center."
 833   (let* ((mol (interpret-markup layout props arg)))
 834     (ly:stencil-aligned-to mol X CENTER)))
 835
 836 (define-builtin-markup-command (right-align layout props arg)
 837   (markup?)
 838   align
 839   ()
 840   "
 841 @cindex right aligning text
 842
 843 Align @var{arg} on its right edge."
 844   (let* ((m (interpret-markup layout props arg)))
 845     (ly:stencil-aligned-to m X RIGHT)))
 846
 847 (define-builtin-markup-command (left-align layout props arg)
 848   (markup?)
 849   align
 850   ()
 851   "
 852 @cindex left aligning text
 853
 854 Align @var{arg} on its left edge."
 855   (let* ((m (interpret-markup layout props arg)))
 856     (ly:stencil-aligned-to m X LEFT)))
 857
 858 (define-builtin-markup-command (general-align layout props axis dir arg)
 859   (integer? number? markup?)
 860   align
 861   ()
 862   "
 863 @cindex controlling general text alignment
 864
 865 Align @var{arg} in @var{axis} direction to the @var{dir} side."
 866   (let* ((m (interpret-markup layout props arg)))
 867     (ly:stencil-aligned-to m axis dir)))
 868
 869 (define-builtin-markup-command (halign layout props dir arg)
 870   (number? markup?)
 871   align
 872   ()
 873   "
 874 @cindex setting horizontal text alignment
 875
 876 Set horizontal alignment.  If @var{dir} is @code{-1}, then it is
 877 left-aligned, while @code{+1} is right.  Values inbetween interpolate
 878 alignment accordingly."
 879   (let* ((m (interpret-markup layout props arg)))
 880     (ly:stencil-aligned-to m X dir)))
 881
 882 (define-builtin-markup-command (with-dimensions layout props x y arg)
 883   (number-pair? number-pair? markup?)
 884   other
 885   ()
 886   "
 887 @cindex setting extent of text objects
 888
 889 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
 890   (let* ((m (interpret-markup layout props arg)))
 891     (ly:make-stencil (ly:stencil-expr m) x y)))
 892
 893 (define-builtin-markup-command (pad-around layout props amount arg)
 894   (number? markup?)
 895   align
 896   ()
 897   "Add padding @var{amount} all around @var{arg}."
 898   (let* ((m (interpret-markup layout props arg))
 899          (x (ly:stencil-extent m X))
 900          (y (ly:stencil-extent m Y)))
 901     (ly:make-stencil (ly:stencil-expr m)
 902                      (interval-widen x amount)
 903                      (interval-widen y amount))))
 904
 905 (define-builtin-markup-command (pad-x layout props amount arg)
 906   (number? markup?)
 907   align
 908   ()
 909   "
 910 @cindex padding text horizontally
 911
 912 Add padding @var{amount} around @var{arg} in the X@tie{}direction."
 913   (let* ((m (interpret-markup layout props arg))
 914          (x (ly:stencil-extent m X))
 915          (y (ly:stencil-extent m Y)))
 916     (ly:make-stencil (ly:stencil-expr m)
 917                      (interval-widen x amount)
 918                      y)))
 919
 920 (define-builtin-markup-command (put-adjacent layout props arg1 axis dir arg2)
 921   (markup? integer? ly:dir? markup?)
 922   align
 923   ()
 924   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
 925   (let ((m1 (interpret-markup layout props arg1))
 926         (m2 (interpret-markup layout props arg2)))
 927     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
 928
 929 (define-builtin-markup-command (transparent layout props arg)
 930   (markup?)
 931   other
 932   ()
 933   "Make the argument transparent."
 934   (let* ((m (interpret-markup layout props arg))
 935          (x (ly:stencil-extent m X))
 936          (y (ly:stencil-extent m Y)))
 937     (ly:make-stencil "" x y)))
 938
 939 (define-builtin-markup-command (pad-to-box layout props x-ext y-ext arg)
 940   (number-pair? number-pair? markup?)
 941   align
 942   ()
 943   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space."
 944   (let* ((m (interpret-markup layout props arg))
 945          (x (ly:stencil-extent m X))
 946          (y (ly:stencil-extent m Y)))
 947     (ly:make-stencil (ly:stencil-expr m)
 948                      (interval-union x-ext x)
 949                      (interval-union y-ext y))))
 950
 951 (define-builtin-markup-command (hcenter-in layout props length arg)
 952   (number? markup?)
 953   align
 954   ()
 955   "Center @var{arg} horizontally within a box of extending
 956 @var{length}/2 to the left and right."
 957   (interpret-markup layout props
 958                     (make-pad-to-box-markup
 959                      (cons (/ length -2) (/ length 2))
 960                      '(0 . 0)
 961                      (make-hcenter-markup arg))))
 962
 963 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 964 ;; property
 965 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 966
 967 (define-builtin-markup-command (fromproperty layout props symbol)
 968   (symbol?)
 969   other
 970   ()
 971   "Read the @var{symbol} from property settings, and produce a stencil
 972 from the markup contained within.  If @var{symbol} is not defined, it
 973 returns an empty markup."
 974   (let ((m (chain-assoc-get symbol props)))
 975     (if (markup? m)
 976         (interpret-markup layout props m)
 977         empty-stencil)))
 978
 979 (define-builtin-markup-command (on-the-fly layout props procedure arg)
 980   (symbol? markup?)
 981   other
 982   ()
 983   "Apply the @var{procedure} markup command to @var{arg}.
 984 @var{procedure} should take a single argument."
 985   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
 986     (set-object-property! anonymous-with-signature
 987                           'markup-signature
 988                           (list markup?))
 989     (interpret-markup layout props (list anonymous-with-signature arg))))
 990
 991 (define-builtin-markup-command (override layout props new-prop arg)
 992   (pair? markup?)
 993   other
 994   ()
 995   "
 996 @cindex overriding properties within text markup
 997
 998 Add the first argument in to the property list.  Properties may be
 999 any sort of property supported by @internalsref{font-interface} and
1000 @internalsref{text-interface}, for example
1001
1002 @example
1003 \\override #'(font-family . married) \"bla\"
1004 @end example"
1005   (interpret-markup layout (cons (list new-prop) props) arg))
1006
1007 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1008 ;; files
1009 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1010
1011 (define-builtin-markup-command (verbatim-file layout props name)
1012   (string?)
1013   other
1014   ()
1015   "Read the contents of a file, and include it verbatim."
1016   (interpret-markup layout props
1017                     (if  (ly:get-option 'safe)
1018                          "verbatim-file disabled in safe mode"
1019                          (let* ((str (ly:gulp-file name))
1020                                 (lines (string-split str #\nl)))
1021                            (make-typewriter-markup
1022                             (make-column-markup lines))))))
1023
1024 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1025 ;; fonts.
1026 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1027
1028 (define-builtin-markup-command (bigger layout props arg)
1029   (markup?)
1030   font
1031   ()
1032   "Increase the font size relative to current setting."
1033   (interpret-markup layout props
1034    `(,fontsize-markup 1 ,arg)))
1035
1036 (define-builtin-markup-command (smaller layout props arg)
1037   (markup?)
1038   font
1039   ()
1040   "Decrease the font size relative to current setting."
1041   (interpret-markup layout props
1042    `(,fontsize-markup -1 ,arg)))
1043
1044 (define-builtin-markup-command larger
1045   (markup?)
1046   font
1047   bigger-markup)
1048
1049 (define-builtin-markup-command (finger layout props arg)
1050   (markup?)
1051   font
1052   ()
1053   "Set the argument as small numbers."
1054   (interpret-markup layout
1055                     (cons '((font-size . -5) (font-encoding . fetaNumber)) props)
1056                     arg))
1057
1058 (define-builtin-markup-command (fontsize layout props increment arg)
1059   (number? markup?)
1060   font
1061   ((font-size 0)
1062    (baseline-skip 2))
1063   "Add @var{increment} to the font-size.  Adjust baseline skip accordingly."
1064   (let ((entries (list
1065                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
1066                   (cons 'font-size (+ font-size increment)))))
1067     (interpret-markup layout (cons entries props) arg)))
1068
1069 (define-builtin-markup-command (magnify layout props sz arg)
1070   (number? markup?)
1071   font
1072   ()
1073   "
1074 @cindex magnifying text
1075
1076 Set the font magnification for its argument.  In the following
1077 example, the middle@tie{}A is 10% larger:
1078
1079 @example
1080 A \\magnify #1.1 @{ A @} A
1081 @end example
1082
1083 Note: Magnification only works if a font name is explicitly selected.
1084 Use @code{\\fontsize} otherwise."
1085   (interpret-markup
1086    layout
1087    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
1088    arg))
1089
1090 (define-builtin-markup-command (bold layout props arg)
1091   (markup?)
1092   font
1093   ()
1094   "Switch to bold font-series."
1095   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
1096
1097 (define-builtin-markup-command (sans layout props arg)
1098   (markup?)
1099   font
1100   ()
1101   "Switch to the sans serif family."
1102   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
1103
1104 (define-builtin-markup-command (number layout props arg)
1105   (markup?)
1106   font
1107   ()
1108   "Set font family to @code{number}, which yields the font used for
1109 time signatures and fingerings.  This font only contains numbers and
1110 some punctuation.  It doesn't have any letters."
1111   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg))
1112
1113 (define-builtin-markup-command (roman layout props arg)
1114   (markup?)
1115   font
1116   ()
1117   "Set font family to @code{roman}."
1118   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
1119
1120 (define-builtin-markup-command (huge layout props arg)
1121   (markup?)
1122   font
1123   ()
1124   "Set font size to +2."
1125   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
1126
1127 (define-builtin-markup-command (large layout props arg)
1128   (markup?)
1129   font
1130   ()
1131   "Set font size to +1."
1132   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
1133
1134 (define-builtin-markup-command (normalsize layout props arg)
1135   (markup?)
1136   font
1137   ()
1138   "Set font size to default."
1139   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
1140
1141 (define-builtin-markup-command (small layout props arg)
1142   (markup?)
1143   font
1144   ()
1145   "Set font size to -1."
1146   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
1147
1148 (define-builtin-markup-command (tiny layout props arg)
1149   (markup?)
1150   font
1151   ()
1152   "Set font size to -2."
1153   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
1154
1155 (define-builtin-markup-command (teeny layout props arg)
1156   (markup?)
1157   font
1158   ()
1159   "Set font size to -3."
1160   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
1161
1162 (define-builtin-markup-command (fontCaps layout props arg)
1163   (markup?)
1164   font
1165   ()
1166   "Set @code{font-shape} to @code{caps}."
1167   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
1168
1169 ;; Poor man's caps
1170 (define-builtin-markup-command (smallCaps layout props text)
1171   (markup?)
1172   font
1173   ()
1174   "Turn @code{text}, which should be a string, to small caps.
1175 @example
1176 \\markup \\smallCaps \"Text between double quotes\"
1177 @end example
1178
1179 Note: @code{\\smallCaps} does not support accented characters."
1180   (define (char-list->markup chars lower)
1181     (let ((final-string (string-upcase (reverse-list->string chars))))
1182       (if lower
1183           (markup #:fontsize -2 final-string)
1184           final-string)))
1185   (define (make-small-caps rest-chars currents current-is-lower prev-result)
1186     (if (null? rest-chars)
1187         (make-concat-markup
1188           (reverse! (cons (char-list->markup currents current-is-lower)
1189                           prev-result)))
1190         (let* ((ch (car rest-chars))
1191                (is-lower (char-lower-case? ch)))
1192           (if (or (and current-is-lower is-lower)
1193                   (and (not current-is-lower) (not is-lower)))
1194               (make-small-caps (cdr rest-chars)
1195                                (cons ch currents)
1196                                is-lower
1197                                prev-result)
1198               (make-small-caps (cdr rest-chars)
1199                                (list ch)
1200                                is-lower
1201                                (if (null? currents)
1202                                    prev-result
1203                                    (cons (char-list->markup
1204                                             currents current-is-lower)
1205                                          prev-result)))))))
1206   (interpret-markup layout props
1207     (if (string? text)
1208         (make-small-caps (string->list text) (list) #f (list))
1209         text)))
1210
1211 (define-builtin-markup-command (caps layout props arg)
1212   (markup?)
1213   font
1214   ()
1215   "Emit @var{arg} as small caps."
1216   (interpret-markup layout props (make-smallCaps-markup arg)))
1217
1218 (define-builtin-markup-command (dynamic layout props arg)
1219   (markup?)
1220   font
1221   ()
1222   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
1223 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
1224 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
1225 done in a different font.  The recommended font for this is bold and italic."
1226   (interpret-markup
1227    layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg))
1228
1229 (define-builtin-markup-command (text layout props arg)
1230   (markup?)
1231   font
1232   ()
1233   "Use a text font instead of music symbol or music alphabet font."
1234
1235   ;; ugh - latin1
1236   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
1237                     arg))
1238
1239 (define-builtin-markup-command (italic layout props arg)
1240   (markup?)
1241   font
1242   ()
1243   "Use italic @code{font-shape} for @var{arg}."
1244   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
1245
1246 (define-builtin-markup-command (typewriter layout props arg)
1247   (markup?)
1248   font
1249   ()
1250   "Use @code{font-family} typewriter for @var{arg}."
1251   (interpret-markup
1252    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
1253
1254 (define-builtin-markup-command (upright layout props arg)
1255   (markup?)
1256   font
1257   ()
1258   "Set font shape to @code{upright}.  This is the opposite of @code{italic}."
1259   (interpret-markup
1260    layout (prepend-alist-chain 'font-shape 'upright props) arg))
1261
1262 (define-builtin-markup-command (medium layout props arg)
1263   (markup?)
1264   font
1265   ()
1266   "Switch to medium font series (in contrast to bold)."
1267   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
1268                     arg))
1269
1270 (define-builtin-markup-command (normal-text layout props arg)
1271   (markup?)
1272   font
1273   ()
1274   "Set all font related properties (except the size) to get the default
1275 normal text font, no matter what font was used earlier."
1276   ;; ugh - latin1
1277   (interpret-markup layout
1278                     (cons '((font-family . roman) (font-shape . upright)
1279                             (font-series . medium) (font-encoding . latin1))
1280                           props)
1281                     arg))
1282
1283 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1284 ;; symbols.
1285 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1286
1287 (define-builtin-markup-command (doublesharp layout props)
1288   ()
1289   music
1290   ()
1291   "Draw a double sharp symbol.
1292 @c
1293 @lilypond[verbatim,quote]
1294 \\markup { \\doublesharp }
1295 @end lilypond"
1296   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
1297
1298 (define-builtin-markup-command (sesquisharp layout props)
1299   ()
1300   music
1301   ()
1302   "Draw a 3/2 sharp symbol.
1303 @c
1304 @lilypond[verbatim,quote]
1305 \\markup { \\sesquisharp }
1306 @end lilypond"
1307   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
1308
1309 (define-builtin-markup-command (sharp layout props)
1310   ()
1311   music
1312   ()
1313   "Draw a sharp symbol.
1314 @c
1315 @lilypond[verbatim,quote]
1316 \\markup { \\sharp }
1317 @end lilypond"
1318   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
1319
1320 (define-builtin-markup-command (semisharp layout props)
1321   ()
1322   music
1323   ()
1324   "Draw a semi sharp symbol.
1325 @c
1326 @lilypond[verbatim,quote]
1327 \\markup { \\semisharp }
1328 @end lilypond"
1329   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
1330
1331 (define-builtin-markup-command (natural layout props)
1332   ()
1333   music
1334   ()
1335   "Draw a natural symbol.
1336 @c
1337 @lilypond[verbatim,quote]
1338 \\markup { \\natural }
1339 @end lilypond"
1340   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
1341
1342 (define-builtin-markup-command (semiflat layout props)
1343   ()
1344   music
1345   ()
1346   "Draw a semiflat symbol.
1347 @c
1348 @lilypond[verbatim,quote]
1349 \\markup { \\semiflat }
1350 @end lilypond"
1351   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
1352
1353 (define-builtin-markup-command (flat layout props)
1354   ()
1355   music
1356   ()
1357   "Draw a flat symbol.
1358 @c
1359 @lilypond[verbatim,quote]
1360 \\markup { \\flat }
1361 @end lilypond"
1362   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
1363
1364 (define-builtin-markup-command (sesquiflat layout props)
1365   ()
1366   music
1367   ()
1368   "Draw a 3/2 flat symbol.
1369 @c
1370 @lilypond[verbatim,quote]
1371 \\markup { \\sesquiflat }
1372 @end lilypond"
1373   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
1374
1375 (define-builtin-markup-command (doubleflat layout props)
1376   ()
1377   music
1378   ()
1379   "Draw a double flat symbol.
1380 @c
1381 @lilypond[verbatim,quote]
1382 \\markup { \\doubleflat }
1383 @end lilypond"
1384   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
1385
1386 (define-builtin-markup-command (with-color layout props color arg)
1387   (color? markup?)
1388   other
1389   ()
1390   "
1391 @cindex coloring text
1392
1393 Draw @var{arg} in color specified by @var{color}."
1394   (let ((stil (interpret-markup layout props arg)))
1395     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
1396                      (ly:stencil-extent stil X)
1397                      (ly:stencil-extent stil Y))))
1398 \f
1399 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1400 ;; glyphs
1401 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1402
1403 (define-builtin-markup-command (arrow-head layout props axis direction filled)
1404   (integer? ly:dir? boolean?)
1405   graphic
1406   ()
1407   "Produce an arrow head in specified direction and axis.
1408 Use the filled head if @var{filled} is specified."
1409   (let*
1410       ((name (format "arrowheads.~a.~a~a"
1411                      (if filled
1412                          "close"
1413                          "open")
1414                      axis
1415                      direction)))
1416     (ly:font-get-glyph
1417      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
1418                                      props))
1419      name)))
1420
1421 (define-builtin-markup-command (musicglyph layout props glyph-name)
1422   (string?)
1423   music
1424   ()
1425   "@var{glyph-name} is converted to a musical symbol; for example,
1426 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
1427 the music font.  See @ruser{The Feta font} for a complete listing of
1428 the possible glyphs."
1429   (ly:font-get-glyph
1430    (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
1431                                    props))
1432    glyph-name))
1433
1434 (define-builtin-markup-command (lookup layout props glyph-name)
1435   (string?)
1436   other
1437   ()
1438   "Lookup a glyph by name."
1439   (ly:font-get-glyph (ly:paper-get-font layout props)
1440                      glyph-name))
1441
1442 (define-builtin-markup-command (char layout props num)
1443   (integer?)
1444   other
1445   ()
1446   "Produce a single character.  For example, @code{\\char #65} produces the
1447 letter @q{A}."
1448   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
1449
1450 (define number->mark-letter-vector (make-vector 25 #\A))
1451
1452 (do ((i 0 (1+ i))
1453      (j 0 (1+ j)))
1454     ((>= i 26))
1455   (if (= i (- (char->integer #\I) (char->integer #\A)))
1456       (set! i (1+ i)))
1457   (vector-set! number->mark-letter-vector j
1458                (integer->char (+ i (char->integer #\A)))))
1459
1460 (define number->mark-alphabet-vector (list->vector
1461   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
1462
1463 (define (number->markletter-string vec n)
1464   "Double letters for big marks."
1465   (let* ((lst (vector-length vec)))
1466
1467     (if (>= n lst)
1468         (string-append (number->markletter-string vec (1- (quotient n lst)))
1469                        (number->markletter-string vec (remainder n lst)))
1470         (make-string 1 (vector-ref vec n)))))
1471
1472 (define-builtin-markup-command (markletter layout props num)
1473   (integer?)
1474   other
1475   ()
1476   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
1477 (skipping letter@tie{}I), and continue with double letters."
1478   (ly:text-interface::interpret-markup layout props
1479     (number->markletter-string number->mark-letter-vector num)))
1480
1481 (define-builtin-markup-command (markalphabet layout props num)
1482   (integer?)
1483   other
1484   ()
1485    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
1486 and continue with double letters."
1487    (ly:text-interface::interpret-markup layout props
1488      (number->markletter-string number->mark-alphabet-vector num)))
1489
1490 (define-builtin-markup-command (slashed-digit layout props num)
1491   (integer?)
1492   other
1493   ((font-size 0)
1494    (thickness 1.6))
1495   "
1496 @cindex slashed digits
1497
1498 A feta number, with slash.  This is for use in the context of
1499 figured bass notation."
1500   (let* ((mag (magstep font-size))
1501          (thickness (* mag
1502                        (ly:output-def-lookup layout 'line-thickness)
1503                        thickness))
1504          (dy (* mag 0.15))
1505          (number-stencil (interpret-markup layout
1506                                            (prepend-alist-chain 'font-encoding 'fetaNumber props)
1507                                            (number->string num)))
1508          (num-x (interval-widen (ly:stencil-extent number-stencil X)
1509                                 (* mag 0.2)))
1510          (num-y (ly:stencil-extent number-stencil Y))
1511          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
1512          (slash-stencil (if is-sane
1513                             (ly:make-stencil
1514                              `(draw-line ,thickness
1515                                          ,(car num-x) ,(- (interval-center num-y) dy)
1516                                          ,(cdr num-x) ,(+ (interval-center num-y) dy))
1517                              num-x num-y)
1518                             #f)))
1519     (set! slash-stencil
1520           (cond ((not (ly:stencil? slash-stencil)) #f)
1521                 ((= num 5)
1522                  (ly:stencil-translate slash-stencil
1523                                        ;;(cons (* mag -0.05) (* mag 0.42))
1524                                        (cons (* mag -0.00) (* mag -0.07))))
1525                 ((= num 7)
1526                  (ly:stencil-translate slash-stencil
1527                                        ;;(cons (* mag -0.05) (* mag 0.42))
1528                                        (cons (* mag -0.00) (* mag -0.15))))
1529                 (else slash-stencil)))
1530     (if slash-stencil
1531         (set! number-stencil
1532               (ly:stencil-add number-stencil slash-stencil))
1533         (ly:warning "invalid number for slashed digit ~a" num))
1534     number-stencil))
1535 \f
1536 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1537 ;; the note command.
1538 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1539
1540 ;; TODO: better syntax.
1541
1542 (define-builtin-markup-command (note-by-number layout props log dot-count dir)
1543   (number? number? number?)
1544   music
1545   ((font-size 0)
1546    (style '()))
1547   "
1548 @cindex notes within text by log and dot-count
1549
1550 Construct a note symbol, with stem.  By using fractional values for
1551 @var{dir}, you can obtain longer or shorter stems."
1552
1553   (define (get-glyph-name-candidates dir log style)
1554     (map (lambda (dir-name)
1555      (format "noteheads.~a~a~a" dir-name (min log 2)
1556              (if (and (symbol? style)
1557                       (not (equal? 'default style)))
1558                  (symbol->string style)
1559                  "")))
1560          (list (if (= dir UP) "u" "d")
1561                "s")))
1562
1563   (define (get-glyph-name font cands)
1564     (if (null? cands)
1565      ""
1566      (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
1567          (get-glyph-name font (cdr cands))
1568          (car cands))))
1569
1570   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
1571          (size-factor (magstep font-size))
1572          (stem-length (*  size-factor (max 3 (- log 1))))
1573          (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style)))
1574          (head-glyph (ly:font-get-glyph font head-glyph-name))
1575          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
1576          (stem-thickness (* size-factor 0.13))
1577          (stemy (* dir stem-length))
1578          (attach-off (cons (interval-index
1579                             (ly:stencil-extent head-glyph X)
1580                             (* (sign dir) (car attach-indices)))
1581                            (* (sign dir)        ; fixme, this is inconsistent between X & Y.
1582                               (interval-index
1583                                (ly:stencil-extent head-glyph Y)
1584                                (cdr attach-indices)))))
1585          (stem-glyph (and (> log 0)
1586                           (ly:round-filled-box
1587                            (ordered-cons (car attach-off)
1588                                          (+ (car attach-off)  (* (- (sign dir)) stem-thickness)))
1589                            (cons (min stemy (cdr attach-off))
1590                                  (max stemy (cdr attach-off)))
1591                            (/ stem-thickness 3))))
1592
1593          (dot (ly:font-get-glyph font "dots.dot"))
1594          (dotwid (interval-length (ly:stencil-extent dot X)))
1595          (dots (and (> dot-count 0)
1596                     (apply ly:stencil-add
1597                            (map (lambda (x)
1598                                   (ly:stencil-translate-axis
1599                                    dot (* 2 x dotwid) X))
1600                                 (iota dot-count)))))
1601          (flaggl (and (> log 2)
1602                       (ly:stencil-translate
1603                        (ly:font-get-glyph font
1604                                           (string-append "flags."
1605                                                          (if (> dir 0) "u" "d")
1606                                                          (number->string log)))
1607                        (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy)))))
1608
1609     (if (and dots flaggl (> dir 0))
1610         (set! dots (ly:stencil-translate-axis dots 0.35 X)))
1611     (if flaggl
1612         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
1613     (if (ly:stencil? stem-glyph)
1614         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
1615         (set! stem-glyph head-glyph))
1616     (if (ly:stencil? dots)
1617         (set! stem-glyph
1618               (ly:stencil-add
1619                (ly:stencil-translate-axis
1620                 dots
1621                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
1622                 X)
1623                stem-glyph)))
1624     stem-glyph))
1625
1626 (define-public log2
1627   (let ((divisor (log 2)))
1628     (lambda (z) (inexact->exact (/ (log z) divisor)))))
1629
1630 (define (parse-simple-duration duration-string)
1631   "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list."
1632   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
1633     (if (and match (string=? duration-string (match:substring match 0)))
1634         (let ((len  (match:substring match 1))
1635               (dots (match:substring match 2)))
1636           (list (cond ((string=? len "breve") -1)
1637                       ((string=? len "longa") -2)
1638                       ((string=? len "maxima") -3)
1639                       (else (log2 (string->number len))))
1640                 (if dots (string-length dots) 0)))
1641         (ly:error (_ "not a valid duration string: ~a") duration-string))))
1642
1643 (define-builtin-markup-command (note layout props duration dir)
1644   (string? number?)
1645   music
1646   (note-by-number-markup)
1647   "
1648 @cindex notes within text by string
1649
1650 This produces a note with a stem pointing in @var{dir} direction, with
1651 the @var{duration} for the note head type and augmentation dots.  For
1652 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
1653 a shortened down stem."
1654   (let ((parsed (parse-simple-duration duration)))
1655     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
1656 \f
1657 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1658 ;; translating.
1659 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1660
1661 (define-builtin-markup-command (lower layout props amount arg)
1662   (number? markup?)
1663   align
1664   ()
1665   "
1666 @cindex lowering text
1667
1668 Lower @var{arg} by the distance @var{amount}.
1669 A negative @var{amount} indicates raising; see also @code{\\raise}."
1670   (ly:stencil-translate-axis (interpret-markup layout props arg)
1671                              (- amount) Y))
1672
1673 (define-builtin-markup-command (translate-scaled layout props offset arg)
1674   (number-pair? markup?)
1675   other
1676   ((font-size 0))
1677   "
1678 @cindex translating text
1679 @cindex scaling text
1680
1681 Translate @var{arg} by @var{offset}, scaling the offset by the
1682 @code{font-size}."
1683   (let* ((factor (magstep font-size))
1684          (scaled (cons (* factor (car offset))
1685                        (* factor (cdr offset)))))
1686     (ly:stencil-translate (interpret-markup layout props arg)
1687                           scaled)))
1688
1689 (define-builtin-markup-command (raise layout props amount arg)
1690   (number? markup?)
1691   align
1692   ()
1693   "
1694 @cindex raising text
1695
1696 Raise @var{arg} by the distance @var{amount}.
1697 A negative @var{amount} indicates lowering, see also @code{\\lower}.
1698
1699 The argument to @code{\\raise} is the vertical displacement amount,
1700 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
1701 raise objects in relation to their surrounding markups.
1702
1703 If the text object itself is positioned above or below the staff, then
1704 @code{\\raise} cannot be used to move it, since the mechanism that
1705 positions it next to the staff cancels any shift made with
1706 @code{\\raise}.  For vertical positioning, use the @code{padding}
1707 and/or @code{extra-offset} properties.
1708 @c
1709 @lilypond[verbatim,quote]
1710 \\markup { C \\small \\raise #1.0 \\bold { \"9/7+\" } }
1711 @end lilypond"
1712   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
1713
1714 (define-builtin-markup-command (fraction layout props arg1 arg2)
1715   (markup? markup?)
1716   other
1717   ((font-size 0))
1718   "
1719 @cindex creating text fractions
1720
1721 Make a fraction of two markups."
1722   (let* ((m1 (interpret-markup layout props arg1))
1723          (m2 (interpret-markup layout props arg2))
1724          (factor (magstep font-size))
1725          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
1726          (padding (* factor 0.2))
1727          (baseline (* factor 0.6))
1728          (offset (* factor 0.75)))
1729     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
1730     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
1731     (let* ((x1 (ly:stencil-extent m1 X))
1732            (x2 (ly:stencil-extent m2 X))
1733            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
1734            ;; should stack mols separately, to maintain LINE on baseline
1735            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
1736       (set! stack
1737             (ly:stencil-aligned-to stack Y CENTER))
1738       (set! stack
1739             (ly:stencil-aligned-to stack X LEFT))
1740       ;; should have EX dimension
1741       ;; empirical anyway
1742       (ly:stencil-translate-axis stack offset Y))))
1743
1744 (define-builtin-markup-command (normal-size-super layout props arg)
1745   (markup?)
1746   font
1747   ((baseline-skip))
1748   "
1749 @cindex setting superscript in standard font size
1750
1751 Set @var{arg} in superscript with a normal font size."
1752   (ly:stencil-translate-axis
1753    (interpret-markup layout props arg)
1754    (* 0.5 baseline-skip) Y))
1755
1756 (define-builtin-markup-command (super layout props arg)
1757   (markup?)
1758   font
1759   ((font-size 0)
1760    (baseline-skip))
1761   "
1762 @cindex superscript text
1763
1764 Raising and lowering texts can be done with @code{\\super} and
1765 @code{\\sub}:
1766 @c
1767 @lilypond[verbatim,quote]
1768 \\markup { E \"=\" \\concat { \"mc\" \\super \"2\" } }
1769 @end lilypond"
1770   (ly:stencil-translate-axis
1771    (interpret-markup
1772     layout
1773     (cons `((font-size . ,(- font-size 3))) props)
1774     arg)
1775    (* 0.5 baseline-skip)
1776    Y))
1777
1778 (define-builtin-markup-command (translate layout props offset arg)
1779   (number-pair? markup?)
1780   align
1781   ()
1782   "
1783 @cindex translating text
1784
1785 This translates an object.  Its first argument is a cons of numbers.
1786
1787 @example
1788 A \\translate #(cons 2 -3) @{ B C @} D
1789 @end example
1790
1791 This moves @q{B C} 2@tie{}spaces to the right, and 3 down, relative to its
1792 surroundings.  This command cannot be used to move isolated scripts
1793 vertically, for the same reason that @code{\\raise} cannot be used for
1794 that."
1795   (ly:stencil-translate (interpret-markup  layout props arg)
1796                         offset))
1797
1798 (define-builtin-markup-command (sub layout props arg)
1799   (markup?)
1800   font
1801   ((font-size 0)
1802    (baseline-skip))
1803   "
1804 @cindex subscript text
1805
1806 Set @var{arg} in subscript."
1807   (ly:stencil-translate-axis
1808    (interpret-markup
1809     layout
1810     (cons `((font-size . ,(- font-size 3))) props)
1811     arg)
1812    (* -0.5 baseline-skip)
1813    Y))
1814
1815 (define-builtin-markup-command (normal-size-sub layout props arg)
1816   (markup?)
1817   font
1818   ((baseline-skip))
1819   "
1820 @cindex setting subscript in standard font size
1821
1822 Set @var{arg} in subscript, in a normal font size."
1823   (ly:stencil-translate-axis
1824    (interpret-markup layout props arg)
1825    (* -0.5 baseline-skip)
1826    Y))
1827 \f
1828 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1829 ;; brackets.
1830 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1831
1832 (define-builtin-markup-command (hbracket layout props arg)
1833   (markup?)
1834   graphic
1835   ()
1836   "
1837 @cindex placing horizontal brackets around text
1838
1839 Draw horizontal brackets around @var{arg}."
1840   (let ((th 0.1) ;; todo: take from GROB.
1841         (m (interpret-markup layout props arg)))
1842     (bracketify-stencil m X th (* 2.5 th) th)))
1843
1844 (define-builtin-markup-command (bracket layout props arg)
1845   (markup?)
1846   graphic
1847   ()
1848   "
1849 @cindex placing vertical brackets around text
1850
1851 Draw vertical brackets around @var{arg}."
1852   (let ((th 0.1) ;; todo: take from GROB.
1853         (m (interpret-markup layout props arg)))
1854     (bracketify-stencil m Y th (* 2.5 th) th)))
1855 \f
1856 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1857 ;; Delayed markup evaluation
1858 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1859
1860 (define-builtin-markup-command (page-ref layout props label gauge default)
1861   (symbol? markup? markup?)
1862   other
1863   ()
1864   "
1865 @cindex referencing page numbers in text
1866
1867 Reference to a page number. @var{label} is the label set on the referenced
1868 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
1869 the maximum width of the page number, and @var{default} the value to display
1870 when @var{label} is not found."
1871   (let* ((gauge-stencil (interpret-markup layout props gauge))
1872          (x-ext (ly:stencil-extent gauge-stencil X))
1873          (y-ext (ly:stencil-extent gauge-stencil Y)))
1874     (ly:make-stencil
1875      `(delay-stencil-evaluation
1876        ,(delay (ly:stencil-expr
1877                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
1878                        (label-page (and (list? table) (assoc label table)))
1879                        (page-number (and label-page (cdr label-page)))
1880                        (page-markup (if page-number (format "~a" page-number) default))
1881                        (page-stencil (interpret-markup layout props page-markup))
1882                        (gap (- (interval-length x-ext)
1883                                (interval-length (ly:stencil-extent page-stencil X)))))
1884                   (interpret-markup layout props
1885                                     (markup #:concat (#:hspace gap page-markup)))))))
1886      x-ext
1887      y-ext)))
1888 \f
1889 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1890 ;; Markup list commands
1891 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1892
1893 (define-public (space-lines baseline-skip lines)
1894   (map (lambda (line)
1895          (stack-lines DOWN 0.0 (/ baseline-skip 2.0)
1896                       (list point-stencil
1897                             line
1898                             point-stencil)))
1899        lines))
1900
1901 (define-builtin-markup-list-command (justified-lines layout props args)
1902   (markup-list?)
1903   ((baseline-skip)
1904    wordwrap-internal-markup-list)
1905   "
1906 @cindex justifying lines of text
1907
1908 Like @code{\\justify}, but return a list of lines instead of a single markup.
1909 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
1910 @var{X}@tie{}is the number of staff spaces."
1911   (space-lines baseline-skip
1912                (interpret-markup-list layout props
1913                                       (make-wordwrap-internal-markup-list #t args))))
1914
1915 (define-builtin-markup-list-command (wordwrap-lines layout props args)
1916   (markup-list?)
1917   ((baseline-skip)
1918    wordwrap-internal-markup-list)
1919   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
1920 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
1921 where @var{X} is the number of staff spaces."
1922   (space-lines baseline-skip
1923                (interpret-markup-list layout props
1924                                       (make-wordwrap-internal-markup-list #f args))))
1925
1926 (define-builtin-markup-list-command (column-lines layout props args)
1927   (markup-list?)
1928   ((baseline-skip))
1929   "Like @code{\\column}, but return a list of lines instead of a single markup.
1930 @code{baseline-skip} determines the space between each markup in @var{args}."
1931   (space-lines (chain-assoc-get 'baseline-skip props)
1932                (interpret-markup-list layout props args)))
1933
1934 (define-builtin-markup-list-command (override-lines layout props new-prop args)
1935   (pair? markup-list?)
1936   ()
1937   "Like @code{\\override}, for markup lists."
1938   (interpret-markup-list layout (cons (list new-prop) props) args))