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