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