]> git.donarmstrong.com Git - lilypond.git/blob - scm/define-markup-commands.scm
Merge branch 'master' of ssh://jeancharlesm@git.sv.gnu.org/srv/git/lilypond
[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 arg1 axis dir arg2)
1447   (markup? integer? ly:dir? markup?)
1448   align
1449   ()
1450   "
1451 @ignore
1452 This is broken, since there's no parser tag for the signature
1453 markup_scm_scm_markup. Only works using Scheme markup. -np
1454 @end ignore
1455
1456 Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1457   (let ((m1 (interpret-markup layout props arg1))
1458         (m2 (interpret-markup layout props arg2)))
1459     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1460
1461 (define-builtin-markup-command (transparent layout props arg)
1462   (markup?)
1463   other
1464   ()
1465   "Make the argument transparent.
1466   
1467 @lilypond[verbatim,quote]
1468 \\markup {
1469   \\transparent {
1470     invisible text
1471   }
1472 }
1473 @end lilypond"
1474   (let* ((m (interpret-markup layout props arg))
1475          (x (ly:stencil-extent m X))
1476          (y (ly:stencil-extent m Y)))
1477     (ly:make-stencil "" x y)))
1478
1479 (define-builtin-markup-command (pad-to-box layout props x-ext y-ext arg)
1480   (number-pair? number-pair? markup?)
1481   align
1482   ()
1483   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space.
1484
1485 @lilypond[verbatim,quote]
1486 \\markup {
1487   \\box {
1488     default
1489   }
1490   \\hspace #4
1491   \\box {
1492     \\pad-to-box #'(0 . 10) #'(0 . 3) {
1493       padded
1494     }
1495   }
1496 }
1497 @end lilypond"
1498   (let* ((m (interpret-markup layout props arg))
1499          (x (ly:stencil-extent m X))
1500          (y (ly:stencil-extent m Y)))
1501     (ly:make-stencil (ly:stencil-expr m)
1502                      (interval-union x-ext x)
1503                      (interval-union y-ext y))))
1504
1505 (define-builtin-markup-command (hcenter-in layout props length arg)
1506   (number? markup?)
1507   align
1508   ()
1509   "Center @var{arg} horizontally within a box of extending
1510 @var{length}/2 to the left and right.
1511
1512 @lilypond[quote,verbatim]
1513 \\new StaffGroup <<
1514   \\new Staff {
1515     \\set Staff.instrumentName = \\markup {
1516       \\hcenter-in #12
1517       Oboe
1518     }
1519     c''1
1520   }
1521   \\new Staff {
1522     \\set Staff.instrumentName = \\markup {
1523       \\hcenter-in #12
1524       Bassoon
1525     }
1526     \\clef tenor
1527     c'1
1528   }
1529 >>
1530 @end lilypond"
1531   (interpret-markup layout props
1532                     (make-pad-to-box-markup
1533                      (cons (/ length -2) (/ length 2))
1534                      '(0 . 0)
1535                      (make-hcenter-markup arg))))
1536
1537 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1538 ;; property
1539 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1540
1541 (define-builtin-markup-command (fromproperty layout props symbol)
1542   (symbol?)
1543   other
1544   ()
1545   "Read the @var{symbol} from property settings, and produce a stencil
1546 from the markup contained within.  If @var{symbol} is not defined, it
1547 returns an empty markup.
1548
1549 @lilypond[verbatim,quote]
1550 \\header {
1551   myTitle = \"myTitle\"
1552   title = \\markup {
1553     from
1554     \\italic
1555     \\fromproperty #'header:myTitle
1556   }
1557 }
1558 \\markup {
1559   \\null
1560 }
1561 @end lilypond"
1562   (let ((m (chain-assoc-get symbol props)))
1563     (if (markup? m)
1564         (interpret-markup layout props m)
1565         empty-stencil)))
1566
1567 (define-builtin-markup-command (on-the-fly layout props procedure arg)
1568   (symbol? markup?)
1569   other
1570   ()
1571   "Apply the @var{procedure} markup command to @var{arg}.
1572 @var{procedure} should take a single argument."
1573   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
1574     (set-object-property! anonymous-with-signature
1575                           'markup-signature
1576                           (list markup?))
1577     (interpret-markup layout props (list anonymous-with-signature arg))))
1578
1579 (define-builtin-markup-command (override layout props new-prop arg)
1580   (pair? markup?)
1581   other
1582   ()
1583   "
1584 @cindex overriding properties within text markup
1585
1586 Add the first argument in to the property list.  Properties may be
1587 any sort of property supported by @rinternals{font-interface} and
1588 @rinternals{text-interface}, for example
1589
1590 @example
1591 \\override #'(font-family . married) \"bla\"
1592 @end example
1593
1594 @lilypond[verbatim,quote]
1595 \\markup {
1596   \\line {
1597     \\column {
1598       default
1599       baseline-skip
1600     }
1601     \\hspace #2
1602     \\override #'(baseline-skip . 4) {
1603       \\column {
1604         increased
1605         baseline-skip
1606       }
1607     }
1608   }
1609 }
1610 @end lilypond"
1611   (interpret-markup layout (cons (list new-prop) props) arg))
1612
1613 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1614 ;; files
1615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1616
1617 (define-builtin-markup-command (verbatim-file layout props name)
1618   (string?)
1619   other
1620   ()
1621   "Read the contents of a file, and include it verbatim.
1622
1623 @lilypond[verbatim,quote]
1624 \\markup {
1625   \\verbatim-file #\"simple.ly\"
1626 }
1627 @end lilypond"
1628   (interpret-markup layout props
1629                     (if  (ly:get-option 'safe)
1630                          "verbatim-file disabled in safe mode"
1631                          (let* ((str (ly:gulp-file name))
1632                                 (lines (string-split str #\nl)))
1633                            (make-typewriter-markup
1634                             (make-column-markup lines))))))
1635
1636 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1637 ;; fonts.
1638 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1639
1640 (define-builtin-markup-command (bigger layout props arg)
1641   (markup?)
1642   font
1643   ()
1644   "Increase the font size relative to current setting.
1645
1646 @lilypond[verbatim,quote]
1647 \\markup {
1648   \\huge {
1649     huge
1650     \\hspace #2
1651     \\bigger {
1652       bigger
1653     }
1654     \\hspace #2
1655     huge
1656   }
1657 }
1658 @end lilypond"
1659   (interpret-markup layout props
1660    `(,fontsize-markup 1 ,arg)))
1661
1662 (define-builtin-markup-command (smaller layout props arg)
1663   (markup?)
1664   font
1665   ()
1666   "Decrease the font size relative to current setting.
1667   
1668 @lilypond[verbatim,quote]
1669 \\markup {
1670   \\fontsize #3.5 {
1671     some large text
1672     \\hspace #2
1673     \\smaller {
1674       a bit smaller
1675     }
1676     \\hspace #2
1677     more large text
1678   }
1679 }
1680 @end lilypond"
1681   (interpret-markup layout props
1682    `(,fontsize-markup -1 ,arg)))
1683
1684 (define-builtin-markup-command (larger layout props arg)
1685   (markup?)
1686   font
1687   ()
1688   "Copy of the @code{\\bigger} command.
1689
1690 @lilypond[verbatim,quote]
1691 \\markup {
1692   default
1693   \\hspace #2
1694   \\larger
1695   larger
1696 }
1697 @end lilypond"
1698   (interpret-markup layout props (make-bigger-markup arg)))
1699
1700 (define-builtin-markup-command (finger layout props arg)
1701   (markup?)
1702   font
1703   ()
1704   "Set the argument as small numbers.
1705 @lilypond[verbatim,quote]
1706 \\markup {
1707   \\finger {
1708     1 2 3 4 5
1709   }
1710 }
1711 @end lilypond"
1712   (interpret-markup layout
1713                     (cons '((font-size . -5) (font-encoding . fetaNumber)) props)
1714                     arg))
1715
1716 (define-builtin-markup-command (abs-fontsize layout props size arg)
1717   (number? markup?)
1718   font
1719   ()
1720   "Use @var{size} as the absolute font size to display @var{arg}.
1721 Adjust baseline skip and word space accordingly.
1722 @lilypond[verbatim,quote]
1723 \\markup {
1724   default text font size
1725   \\hspace #2
1726   \\abs-fontsize #16 { text font size 16 }
1727   \\hspace #2
1728   \\abs-fontsize #12 { text font size 12 }
1729 }
1730 @end lilypond"
1731   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
1732          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
1733          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
1734          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
1735          (magnification (/ size ref-size)))
1736     (interpret-markup layout
1737                       (cons `((baseline-skip . ,(* magnification ref-baseline))
1738                               (word-space . ,(* magnification ref-word-space))
1739                               (font-size . ,(magnification->font-size magnification)))
1740                             props)
1741                       arg)))
1742
1743 (define-builtin-markup-command (fontsize layout props increment arg)
1744   (number? markup?)
1745   font
1746   ((font-size 0)
1747    (word-space 1)
1748    (baseline-skip 2))
1749   "Add @var{increment} to the font-size.  Adjust baseline skip accordingly.
1750 @lilypond[verbatim,quote]
1751 \\markup {
1752   default
1753   \\hspace #2
1754   \\fontsize #-1.5
1755   smaller
1756 }
1757 @end lilypond"
1758   (let ((entries (list
1759                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
1760                   (cons 'word-space (* word-space (magstep increment)))
1761                   (cons 'font-size (+ font-size increment)))))
1762     (interpret-markup layout (cons entries props) arg)))
1763
1764 (define-builtin-markup-command (magnify layout props sz arg)
1765   (number? markup?)
1766   font
1767   ()
1768   "
1769 @cindex magnifying text
1770
1771 Set the font magnification for its argument.  In the following
1772 example, the middle@tie{}A is 10% larger:
1773
1774 @example
1775 A \\magnify #1.1 @{ A @} A
1776 @end example
1777
1778 Note: Magnification only works if a font name is explicitly selected.
1779 Use @code{\\fontsize} otherwise.
1780
1781 @lilypond[verbatim,quote]
1782 \\markup {
1783   default
1784   \\hspace #2
1785   \\magnify #1.5 {
1786     50% larger
1787   }
1788 }
1789 @end lilypond"
1790   (interpret-markup
1791    layout 
1792    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
1793    arg))
1794
1795 (define-builtin-markup-command (bold layout props arg)
1796   (markup?)
1797   font
1798   ()
1799   "Switch to bold font-series.
1800   
1801 @lilypond[verbatim,quote]
1802 \\markup {
1803   default
1804   \\hspace #2
1805   \\bold
1806   bold
1807 }
1808 @end lilypond"
1809   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
1810
1811 (define-builtin-markup-command (sans layout props arg)
1812   (markup?)
1813   font
1814   ()
1815   "Switch to the sans serif family.
1816   
1817 @lilypond[verbatim,quote]
1818 \\markup {
1819   default
1820   \\hspace #2
1821   \\sans {
1822     sans serif
1823   }
1824 }
1825 @end lilypond"
1826   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
1827
1828 (define-builtin-markup-command (number layout props arg)
1829   (markup?)
1830   font
1831   ()
1832   "Set font family to @code{number}, which yields the font used for
1833 time signatures and fingerings.  This font only contains numbers and
1834 some punctuation.  It doesn't have any letters.
1835
1836 @lilypond[verbatim,quote]
1837 \\markup {
1838   \\number {
1839     0 1 2 3 4 5 6 7 8 9 . ,
1840   }
1841 }
1842 @end lilypond"
1843   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaNumber props) arg))
1844
1845 (define-builtin-markup-command (roman layout props arg)
1846   (markup?)
1847   font
1848   ()
1849   "Set font family to @code{roman}.
1850   
1851 @lilypond[verbatim,quote]
1852 \\markup {
1853   \\sans \\bold {
1854     sans serif, bold
1855     \\hspace #2
1856     \\roman {
1857       text in roman font family
1858     }
1859     \\hspace #2
1860     return to sans
1861   }
1862 }
1863 @end lilypond"
1864   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
1865
1866 (define-builtin-markup-command (huge layout props arg)
1867   (markup?)
1868   font
1869   ()
1870   "Set font size to +2.
1871
1872 @lilypond[verbatim,quote]
1873 \\markup {
1874   default
1875   \\hspace #2
1876   \\huge
1877   huge
1878 }
1879 @end lilypond"
1880   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
1881
1882 (define-builtin-markup-command (large layout props arg)
1883   (markup?)
1884   font
1885   ()
1886   "Set font size to +1.
1887
1888 @lilypond[verbatim,quote]
1889 \\markup {
1890   default
1891   \\hspace #2
1892   \\large
1893   large
1894 }
1895 @end lilypond"
1896   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
1897
1898 (define-builtin-markup-command (normalsize layout props arg)
1899   (markup?)
1900   font
1901   ()
1902   "Set font size to default.
1903   
1904 @lilypond[verbatim,quote]
1905 \\markup {
1906   \\teeny {
1907     this is very small
1908     \\hspace #2
1909     \\normalsize {
1910       normal size
1911     }
1912     \\hspace #2
1913     teeny again
1914   }
1915 }
1916 @end lilypond"
1917   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
1918
1919 (define-builtin-markup-command (small layout props arg)
1920   (markup?)
1921   font
1922   ()
1923   "Set font size to -1.
1924   
1925 @lilypond[verbatim,quote]
1926 \\markup {
1927   default
1928   \\hspace #2
1929   \\small
1930   small
1931 }
1932 @end lilypond"
1933   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
1934
1935 (define-builtin-markup-command (tiny layout props arg)
1936   (markup?)
1937   font
1938   ()
1939   "Set font size to -2.
1940   
1941 @lilypond[verbatim,quote]
1942 \\markup {
1943   default
1944   \\hspace #2
1945   \\tiny
1946   tiny
1947 }
1948 @end lilypond"
1949   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
1950
1951 (define-builtin-markup-command (teeny layout props arg)
1952   (markup?)
1953   font
1954   ()
1955   "Set font size to -3.
1956   
1957 @lilypond[verbatim,quote]
1958 \\markup {
1959   default
1960   \\hspace #2
1961   \\teeny
1962   teeny
1963 }
1964 @end lilypond"
1965   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
1966
1967 (define-builtin-markup-command (fontCaps layout props arg)
1968   (markup?)
1969   font
1970   ()
1971   "Set @code{font-shape} to @code{caps}
1972   
1973 Note: @code{\\fontCaps} requires the installation and selection of
1974 fonts which support the @code{caps} font shape."
1975   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
1976
1977 ;; Poor man's caps
1978 (define-builtin-markup-command (smallCaps layout props text)
1979   (markup?)
1980   font
1981   ()
1982   "Emit @var{arg} as small caps.
1983
1984 Note: @code{\\smallCaps} does not support accented characters.
1985
1986 @lilypond[verbatim,quote]
1987 \\markup {
1988   default
1989   \\hspace #2
1990   \\smallCaps {
1991     Text in small caps
1992   }
1993 }
1994 @end lilypond"
1995   (define (char-list->markup chars lower)
1996     (let ((final-string (string-upcase (reverse-list->string chars))))
1997       (if lower
1998           (markup #:fontsize -2 final-string)
1999           final-string)))
2000   (define (make-small-caps rest-chars currents current-is-lower prev-result)
2001     (if (null? rest-chars)
2002         (make-concat-markup
2003           (reverse! (cons (char-list->markup currents current-is-lower)
2004                           prev-result)))
2005         (let* ((ch (car rest-chars))
2006                (is-lower (char-lower-case? ch)))
2007           (if (or (and current-is-lower is-lower)
2008                   (and (not current-is-lower) (not is-lower)))
2009               (make-small-caps (cdr rest-chars)
2010                                (cons ch currents)
2011                                is-lower
2012                                prev-result)
2013               (make-small-caps (cdr rest-chars)
2014                                (list ch)
2015                                is-lower
2016                                (if (null? currents)
2017                                    prev-result
2018                                    (cons (char-list->markup
2019                                             currents current-is-lower)
2020                                          prev-result)))))))
2021   (interpret-markup layout props
2022     (if (string? text)
2023         (make-small-caps (string->list text) (list) #f (list))
2024         text)))
2025
2026 (define-builtin-markup-command (caps layout props arg)
2027   (markup?)
2028   font
2029   ()
2030   "Copy of the @code{\\smallCaps} command.
2031
2032 @lilypond[verbatim,quote]
2033 \\markup {
2034   default
2035   \\hspace #2
2036   \\caps {
2037     Text in small caps
2038   }
2039 }
2040 @end lilypond"
2041   (interpret-markup layout props (make-smallCaps-markup arg)))
2042
2043 (define-builtin-markup-command (dynamic layout props arg)
2044   (markup?)
2045   font
2046   ()
2047   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
2048 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
2049 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
2050 done in a different font.  The recommended font for this is bold and italic.
2051 @lilypond[verbatim,quote]
2052 \\markup {
2053   \\dynamic {
2054     sfzp
2055   }
2056 }
2057 @end lilypond"
2058   (interpret-markup
2059    layout (prepend-alist-chain 'font-encoding 'fetaDynamic props) arg))
2060
2061 (define-builtin-markup-command (text layout props arg)
2062   (markup?)
2063   font
2064   ()
2065   "Use a text font instead of music symbol or music alphabet font.
2066   
2067 @lilypond[verbatim,quote]
2068 \\markup {
2069   \\number {
2070     1, 2,
2071     \\text {
2072       three, four,
2073     }
2074     5
2075   }
2076 }
2077 @end lilypond"
2078
2079   ;; ugh - latin1
2080   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
2081                     arg))
2082
2083 (define-builtin-markup-command (italic layout props arg)
2084   (markup?)
2085   font
2086   ()
2087   "Use italic @code{font-shape} for @var{arg}.
2088
2089 @lilypond[verbatim,quote]
2090 \\markup {
2091   default
2092   \\hspace #2
2093   \\italic
2094   italic
2095 }
2096 @end lilypond"
2097   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
2098
2099 (define-builtin-markup-command (typewriter layout props arg)
2100   (markup?)
2101   font
2102   ()
2103   "Use @code{font-family} typewriter for @var{arg}.
2104   
2105 @lilypond[verbatim,quote]
2106 \\markup {
2107   default
2108   \\hspace #2
2109   \\typewriter
2110   typewriter
2111 }
2112 @end lilypond"
2113   (interpret-markup
2114    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
2115
2116 (define-builtin-markup-command (upright layout props arg)
2117   (markup?)
2118   font
2119   ()
2120   "Set font shape to @code{upright}.  This is the opposite of @code{italic}.
2121
2122 @lilypond[verbatim,quote]
2123 \\markup {
2124   \\italic {
2125     italic text
2126     \\hspace #2
2127     \\upright {
2128       upright text
2129     }
2130     \\hspace #2
2131     italic again
2132   }
2133 }
2134 @end lilypond"
2135   (interpret-markup
2136    layout (prepend-alist-chain 'font-shape 'upright props) arg))
2137
2138 (define-builtin-markup-command (medium layout props arg)
2139   (markup?)
2140   font
2141   ()
2142   "Switch to medium font series (in contrast to bold).
2143
2144 @lilypond[verbatim,quote]
2145 \\markup {
2146   \\bold {
2147     some bold text
2148     \\hspace #2
2149     \\medium {
2150       medium font series
2151     }
2152     \\hspace #2
2153     bold again
2154   }
2155 }
2156 @end lilypond"
2157   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2158                     arg))
2159
2160 (define-builtin-markup-command (normal-text layout props arg)
2161   (markup?)
2162   font
2163   ()
2164   "Set all font related properties (except the size) to get the default
2165 normal text font, no matter what font was used earlier.
2166
2167 @lilypond[verbatim,quote]
2168 \\markup {
2169   \\huge \\bold \\sans \\caps {
2170     Some text with font overrides
2171     \\hspace #2
2172     \\normal-text {
2173       Default text, same font-size
2174     }
2175     \\hspace #2
2176     More text as before
2177   }
2178 }
2179 @end lilypond"
2180   ;; ugh - latin1
2181   (interpret-markup layout
2182                     (cons '((font-family . roman) (font-shape . upright)
2183                             (font-series . medium) (font-encoding . latin1))
2184                           props)
2185                     arg))
2186
2187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2188 ;; symbols.
2189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2190
2191 (define-builtin-markup-command (doublesharp layout props)
2192   ()
2193   music
2194   ()
2195   "Draw a double sharp symbol.
2196
2197 @lilypond[verbatim,quote]
2198 \\markup {
2199   \\doublesharp
2200 }
2201 @end lilypond"
2202   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2203
2204 (define-builtin-markup-command (sesquisharp layout props)
2205   ()
2206   music
2207   ()
2208   "Draw a 3/2 sharp symbol.
2209
2210 @lilypond[verbatim,quote]
2211 \\markup {
2212   \\sesquisharp
2213 }
2214 @end lilypond"
2215   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))                                         
2216
2217 (define-builtin-markup-command (sharp layout props)
2218   ()
2219   music
2220   ()
2221   "Draw a sharp symbol.
2222
2223 @lilypond[verbatim,quote]
2224 \\markup {
2225   \\sharp
2226 }
2227 @end lilypond"
2228   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2229
2230 (define-builtin-markup-command (semisharp layout props)
2231   ()
2232   music
2233   ()
2234   "Draw a semi sharp symbol.
2235
2236 @lilypond[verbatim,quote]
2237 \\markup {
2238   \\semisharp
2239 }
2240 @end lilypond"
2241   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2242
2243 (define-builtin-markup-command (natural layout props)
2244   ()
2245   music
2246   ()
2247   "Draw a natural symbol.
2248
2249 @lilypond[verbatim,quote]
2250 \\markup {
2251   \\natural
2252 }
2253 @end lilypond"
2254   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2255
2256 (define-builtin-markup-command (semiflat layout props)
2257   ()
2258   music
2259   ()
2260   "Draw a semiflat symbol.
2261
2262 @lilypond[verbatim,quote]
2263 \\markup {
2264   \\semiflat
2265 }
2266 @end lilypond"
2267   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2268
2269 (define-builtin-markup-command (flat layout props)
2270   ()
2271   music
2272   ()
2273   "Draw a flat symbol.
2274
2275 @lilypond[verbatim,quote]
2276 \\markup {
2277   \\flat
2278 }
2279 @end lilypond"
2280   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2281
2282 (define-builtin-markup-command (sesquiflat layout props)
2283   ()
2284   music
2285   ()
2286   "Draw a 3/2 flat symbol.
2287
2288 @lilypond[verbatim,quote]
2289 \\markup {
2290   \\sesquiflat
2291 }
2292 @end lilypond"
2293   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2294
2295 (define-builtin-markup-command (doubleflat layout props)
2296   ()
2297   music
2298   ()
2299   "Draw a double flat symbol.
2300
2301 @lilypond[verbatim,quote]
2302 \\markup {
2303   \\doubleflat
2304 }
2305 @end lilypond"
2306   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2307
2308 (define-builtin-markup-command (with-color layout props color arg)
2309   (color? markup?)
2310   other
2311   ()
2312   "
2313 @cindex coloring text
2314
2315 Draw @var{arg} in color specified by @var{color}.
2316
2317 @lilypond[verbatim,quote]
2318 \\markup {
2319   \\with-color #red
2320   red
2321   \\hspace #2
2322   \\with-color #green
2323   green
2324   \\hspace #2
2325   \\with-color #blue
2326   blue
2327 }
2328 @end lilypond"
2329   (let ((stil (interpret-markup layout props arg)))
2330     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2331                      (ly:stencil-extent stil X)
2332                      (ly:stencil-extent stil Y))))
2333 \f
2334 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2335 ;; glyphs
2336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2337
2338 (define-builtin-markup-command (arrow-head layout props axis direction filled)
2339   (integer? ly:dir? boolean?)
2340   graphic
2341   ()
2342   "Produce an arrow head in specified direction and axis.
2343 Use the filled head if @var{filled} is specified.
2344 @lilypond[verbatim,quote]
2345 \\markup {
2346   \\fontsize #5 {
2347     \\general-align #Y #DOWN {
2348       \\arrow-head #Y #UP ##t
2349       \\arrow-head #Y #DOWN ##f
2350       \\hspace #2
2351       \\arrow-head #X #RIGHT ##f
2352       \\arrow-head #X #LEFT ##f
2353     }
2354   }
2355 }
2356 @end lilypond"
2357   (let*
2358       ((name (format "arrowheads.~a.~a~a"
2359                      (if filled
2360                          "close"
2361                          "open")
2362                      axis
2363                      direction)))
2364     (ly:font-get-glyph
2365      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2366                                      props))
2367      name)))
2368
2369 (define-builtin-markup-command (musicglyph layout props glyph-name)
2370   (string?)
2371   music
2372   ()
2373   "@var{glyph-name} is converted to a musical symbol; for example,
2374 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2375 the music font.  See @ruser{The Feta font} for a complete listing of
2376 the possible glyphs.
2377
2378 @lilypond[verbatim,quote]
2379 \\markup {
2380   \\musicglyph #\"f\"
2381   \\musicglyph #\"rests.2\"
2382   \\musicglyph #\"clefs.G_change\"
2383 }
2384 @end lilypond"
2385   (let* ((font (ly:paper-get-font layout
2386                                   (cons '((font-encoding . fetaMusic)
2387                                           (font-name . #f))
2388                                         
2389                                                  props)))
2390          (glyph (ly:font-get-glyph font glyph-name)))
2391     (if (null? (ly:stencil-expr glyph))
2392         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2393
2394     glyph))
2395
2396
2397 (define-builtin-markup-command (lookup layout props glyph-name)
2398   (string?)
2399   other
2400   ()
2401   "Lookup a glyph by name.
2402   
2403 @lilypond[verbatim,quote]
2404 \\markup {
2405   \\override #'(font-encoding . fetaBraces) {
2406     \\lookup #\"brace200\"
2407     \\hspace #2
2408     \\rotate #180
2409     \\lookup #\"brace180\"
2410   }
2411 }
2412 @end lilypond"
2413   (ly:font-get-glyph (ly:paper-get-font layout props)
2414                      glyph-name))
2415
2416 (define-builtin-markup-command (char layout props num)
2417   (integer?)
2418   other
2419   ()
2420   "Produce a single character.  For example, @code{\\char #65} produces the 
2421 letter @q{A}.
2422
2423 @lilypond[verbatim,quote]
2424 \\markup {
2425   \\char #65
2426 }
2427 @end lilypond"
2428   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2429
2430 (define number->mark-letter-vector (make-vector 25 #\A))
2431
2432 (do ((i 0 (1+ i))
2433      (j 0 (1+ j)))
2434     ((>= i 26))
2435   (if (= i (- (char->integer #\I) (char->integer #\A)))
2436       (set! i (1+ i)))
2437   (vector-set! number->mark-letter-vector j
2438                (integer->char (+ i (char->integer #\A)))))
2439
2440 (define number->mark-alphabet-vector (list->vector
2441   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2442
2443 (define (number->markletter-string vec n)
2444   "Double letters for big marks."
2445   (let* ((lst (vector-length vec)))
2446     
2447     (if (>= n lst)
2448         (string-append (number->markletter-string vec (1- (quotient n lst)))
2449                        (number->markletter-string vec (remainder n lst)))
2450         (make-string 1 (vector-ref vec n)))))
2451
2452 (define-builtin-markup-command (markletter layout props num)
2453   (integer?)
2454   other
2455   ()
2456   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2457 (skipping letter@tie{}I), and continue with double letters.
2458
2459 @lilypond[verbatim,quote]
2460 \\markup {
2461   \\markletter #8
2462   \\hspace #2
2463   \\markletter #26
2464 }
2465 @end lilypond"
2466   (ly:text-interface::interpret-markup layout props
2467     (number->markletter-string number->mark-letter-vector num)))
2468
2469 (define-builtin-markup-command (markalphabet layout props num)
2470   (integer?)
2471   other
2472   ()
2473    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2474 and continue with double letters.
2475
2476 @lilypond[verbatim,quote]
2477 \\markup {
2478   \\markalphabet #8
2479   \\hspace #2
2480   \\markalphabet #26
2481 }
2482 @end lilypond"
2483    (ly:text-interface::interpret-markup layout props
2484      (number->markletter-string number->mark-alphabet-vector num)))
2485
2486 (define-public (horizontal-slash-interval num forward number-interval mag)
2487   (ly:message "Mag step: ~a" mag)
2488   (if forward
2489     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
2490           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2491           (else (interval-widen number-interval (* mag 0.25))))
2492     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
2493           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2494           (else (interval-widen number-interval (* mag 0.25))))
2495   ))
2496
2497 (define-public (adjust-slash-stencil num forward stencil mag)
2498   (if forward
2499     (cond ((= num 2)
2500               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2501           ((= num 3)
2502               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2503           ;((= num 5)
2504               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
2505           ;((= num 7)
2506           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2507           (else stencil))
2508     (cond ((= num 6)
2509               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
2510           ;((= num 8)
2511           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2512           (else stencil))
2513   )
2514 )
2515
2516 (define (slashed-digit-internal layout props num forward font-size thickness)
2517   (let* ((mag (magstep font-size))
2518          (thickness (* mag
2519                        (ly:output-def-lookup layout 'line-thickness)
2520                        thickness))
2521          ; backward slashes might use slope and point in the other direction!
2522          (dy (* mag (if forward 0.4 -0.4)))
2523          (number-stencil (interpret-markup layout
2524                                            (prepend-alist-chain 'font-encoding 'fetaNumber props)
2525                                            (number->string num)))
2526          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
2527          (center (interval-center (ly:stencil-extent number-stencil Y)))
2528          ; Use the real extents of the slash, not the whole number, because we
2529          ; might translate the slash later on!
2530          (num-y (interval-widen (cons center center) (abs dy)))
2531          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
2532          (slash-stencil (if is-sane
2533                             (ly:make-stencil
2534                              `(draw-line ,thickness
2535                                          ,(car num-x) ,(- (interval-center num-y) dy)
2536                                          ,(cdr num-x) ,(+ (interval-center num-y) dy))
2537                              num-x num-y)
2538                             #f)))
2539 (ly:message "Num: ~a, X-interval: ~a" num num-x)
2540     (if (ly:stencil? slash-stencil)
2541       (begin
2542         ; for some numbers we need to shift the slash/backslash up or down to make
2543         ; the slashed digit look better
2544         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
2545         (set! number-stencil
2546           (ly:stencil-add number-stencil slash-stencil)))
2547       (ly:warning "Unable to create slashed digit ~a" num))
2548     number-stencil))
2549
2550
2551 (define-builtin-markup-command (slashed-digit layout props num)
2552   (integer?)
2553   other
2554   ((font-size 0)
2555    (thickness 1.6))
2556   "
2557 @cindex slashed digits
2558
2559 A feta number, with slash.  This is for use in the context of
2560 figured bass notation.
2561 @lilypond[verbatim,quote]
2562 \\markup {
2563   \\slashed-digit #5
2564   \\hspace #2
2565   \\override #'(thickness . 3)
2566   \\slashed-digit #7
2567 }
2568 @end lilypond"
2569   (slashed-digit-internal layout props num #t font-size thickness))
2570
2571 (define-builtin-markup-command (backslashed-digit layout props num)
2572   (integer?)
2573   other
2574   ((font-size 0)
2575    (thickness 1.6))
2576   "
2577 @cindex backslashed digits
2578
2579 A feta number, with backslash.  This is for use in the context of
2580 figured bass notation.
2581 @lilypond[verbatim,quote]
2582 \\markup {
2583   \\backslashed-digit #5
2584   \\hspace #2
2585   \\override #'(thickness . 3)
2586   \\backslashed-digit #7
2587 }
2588 @end lilypond"
2589   (slashed-digit-internal layout props num #f font-size thickness))
2590
2591 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2592 ;; the note command.
2593 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2594
2595 ;; TODO: better syntax.
2596
2597 (define-builtin-markup-command (note-by-number layout props log dot-count dir)
2598   (number? number? number?)
2599   music
2600   ((font-size 0)
2601    (style '()))
2602   "
2603 @cindex notes within text by log and dot-count
2604
2605 Construct a note symbol, with stem.  By using fractional values for
2606 @var{dir}, you can obtain longer or shorter stems.
2607
2608 @lilypond[verbatim,quote]
2609 \\markup {
2610   \\note-by-number #3 #0 #DOWN
2611   \\hspace #2
2612   \\note-by-number #1 #2 #0.8
2613 }
2614 @end lilypond"
2615   (define (get-glyph-name-candidates dir log style)
2616     (map (lambda (dir-name)
2617      (format "noteheads.~a~a~a" dir-name (min log 2)
2618              (if (and (symbol? style)
2619                       (not (equal? 'default style)))
2620                  (symbol->string style)
2621                  "")))
2622          (list (if (= dir UP) "u" "d")
2623                "s")))
2624                    
2625   (define (get-glyph-name font cands)
2626     (if (null? cands)
2627      ""
2628      (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
2629          (get-glyph-name font (cdr cands))
2630          (car cands))))
2631     
2632   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props)))
2633          (size-factor (magstep font-size))
2634          (stem-length (*  size-factor (max 3 (- log 1))))
2635          (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style)))
2636          (head-glyph (ly:font-get-glyph font head-glyph-name))
2637          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
2638          (stem-thickness (* size-factor 0.13))
2639          (stemy (* dir stem-length))
2640          (attach-off (cons (interval-index
2641                             (ly:stencil-extent head-glyph X)
2642                             (* (sign dir) (car attach-indices)))
2643                            (* (sign dir)        ; fixme, this is inconsistent between X & Y.
2644                               (interval-index
2645                                (ly:stencil-extent head-glyph Y)
2646                                (cdr attach-indices)))))
2647          (stem-glyph (and (> log 0)
2648                           (ly:round-filled-box
2649                            (ordered-cons (car attach-off)
2650                                          (+ (car attach-off)  (* (- (sign dir)) stem-thickness)))
2651                            (cons (min stemy (cdr attach-off))
2652                                  (max stemy (cdr attach-off)))
2653                            (/ stem-thickness 3))))
2654          
2655          (dot (ly:font-get-glyph font "dots.dot"))
2656          (dotwid (interval-length (ly:stencil-extent dot X)))
2657          (dots (and (> dot-count 0)
2658                     (apply ly:stencil-add
2659                            (map (lambda (x)
2660                                   (ly:stencil-translate-axis
2661                                    dot (* 2 x dotwid) X))
2662                                 (iota dot-count)))))
2663          (flaggl (and (> log 2)
2664                       (ly:stencil-translate
2665                        (ly:font-get-glyph font
2666                                           (string-append "flags."
2667                                                          (if (> dir 0) "u" "d")
2668                                                          (number->string log)))
2669                        (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy)))))
2670
2671     ; If there is a flag on an upstem and the stem is short, move the dots to avoid the flag.
2672     ; 16th notes get a special case because their flags hang lower than any other flags.
2673     (if (and dots (> dir 0) (> log 2) (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
2674         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
2675     (if flaggl
2676         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
2677     (if (ly:stencil? stem-glyph)
2678         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
2679         (set! stem-glyph head-glyph))
2680     (if (ly:stencil? dots)
2681         (set! stem-glyph
2682               (ly:stencil-add
2683                (ly:stencil-translate-axis
2684                 dots
2685                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
2686                 X)
2687                stem-glyph)))
2688     stem-glyph))
2689
2690 (define-public log2 
2691   (let ((divisor (log 2)))
2692     (lambda (z) (inexact->exact (/ (log z) divisor)))))
2693
2694 (define (parse-simple-duration duration-string)
2695   "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list."
2696   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string)))
2697     (if (and match (string=? duration-string (match:substring match 0)))
2698         (let ((len  (match:substring match 1))
2699               (dots (match:substring match 2)))
2700           (list (cond ((string=? len "breve") -1)
2701                       ((string=? len "longa") -2)
2702                       ((string=? len "maxima") -3)
2703                       (else (log2 (string->number len))))
2704                 (if dots (string-length dots) 0)))
2705         (ly:error (_ "not a valid duration string: ~a") duration-string))))
2706
2707 (define-builtin-markup-command (note layout props duration dir)
2708   (string? number?)
2709   music
2710   (note-by-number-markup)
2711   "
2712 @cindex notes within text by string
2713
2714 This produces a note with a stem pointing in @var{dir} direction, with
2715 the @var{duration} for the note head type and augmentation dots.  For
2716 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
2717 a shortened down stem.
2718
2719 @lilypond[verbatim,quote]
2720 \\markup {
2721   \\override #'(style . cross) {
2722     \\note #\"4..\" #UP
2723   }
2724   \\hspace #2
2725   \\note #\"breve\" #0
2726 }
2727 @end lilypond"
2728   (let ((parsed (parse-simple-duration duration)))
2729     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
2730
2731 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2732 ;; translating.
2733 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2734
2735 (define-builtin-markup-command (lower layout props amount arg)
2736   (number? markup?)
2737   align
2738   ()
2739   "
2740 @cindex lowering text
2741
2742 Lower @var{arg} by the distance @var{amount}.
2743 A negative @var{amount} indicates raising; see also @code{\\raise}.
2744
2745 @lilypond[verbatim,quote]
2746 \\markup {
2747   default
2748   \\lower #3 {
2749     three spaces lower
2750   }
2751 }
2752 @end lilypond"
2753   (ly:stencil-translate-axis (interpret-markup layout props arg)
2754                              (- amount) Y))
2755
2756 (define-builtin-markup-command (translate-scaled layout props offset arg)
2757   (number-pair? markup?)
2758   align
2759   ((font-size 0))
2760   "
2761 @cindex translating text
2762 @cindex scaling text
2763
2764 Translate @var{arg} by @var{offset}, scaling the offset by the
2765 @code{font-size}.
2766
2767 @lilypond[verbatim,quote]
2768 \\markup {
2769   \\fontsize #5 {
2770     * \\translate #'(2 . 3) translate
2771     \\hspace #2
2772     * \\translate-scaled #'(2 . 3) translate-scaled
2773   }
2774 }
2775 @end lilypond"
2776   (let* ((factor (magstep font-size))
2777          (scaled (cons (* factor (car offset))
2778                        (* factor (cdr offset)))))
2779     (ly:stencil-translate (interpret-markup layout props arg)
2780                           scaled)))
2781
2782 (define-builtin-markup-command (raise layout props amount arg)
2783   (number? markup?)
2784   align
2785   ()
2786   "
2787 @cindex raising text
2788   
2789 Raise @var{arg} by the distance @var{amount}.
2790 A negative @var{amount} indicates lowering, see also @code{\\lower}.
2791
2792 The argument to @code{\\raise} is the vertical displacement amount,
2793 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
2794 raise objects in relation to their surrounding markups.
2795
2796 If the text object itself is positioned above or below the staff, then
2797 @code{\\raise} cannot be used to move it, since the mechanism that
2798 positions it next to the staff cancels any shift made with
2799 @code{\\raise}.  For vertical positioning, use the @code{padding}
2800 and/or @code{extra-offset} properties.
2801
2802 @lilypond[verbatim,quote]
2803 \\markup {
2804   C
2805   \\small
2806   \\bold
2807   \\raise #1.0
2808   9/7+
2809 }
2810 @end lilypond"
2811   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
2812
2813 (define-builtin-markup-command (fraction layout props arg1 arg2)
2814   (markup? markup?)
2815   other
2816   ((font-size 0))
2817   "
2818 @cindex creating text fractions
2819
2820 Make a fraction of two markups.
2821 @lilypond[verbatim,quote]
2822 \\markup {
2823   Ï€ â‰ˆ
2824   \\fraction 355 113
2825 }
2826 @end lilypond"
2827   (let* ((m1 (interpret-markup layout props arg1))
2828          (m2 (interpret-markup layout props arg2))
2829          (factor (magstep font-size))
2830          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
2831          (padding (* factor 0.2))
2832          (baseline (* factor 0.6))
2833          (offset (* factor 0.75)))
2834     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
2835     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
2836     (let* ((x1 (ly:stencil-extent m1 X))
2837            (x2 (ly:stencil-extent m2 X))
2838            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
2839            ;; should stack mols separately, to maintain LINE on baseline
2840            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
2841       (set! stack
2842             (ly:stencil-aligned-to stack Y CENTER))
2843       (set! stack
2844             (ly:stencil-aligned-to stack X LEFT))
2845       ;; should have EX dimension
2846       ;; empirical anyway
2847       (ly:stencil-translate-axis stack offset Y))))
2848
2849 (define-builtin-markup-command (normal-size-super layout props arg)
2850   (markup?)
2851   font
2852   ((baseline-skip))
2853   "
2854 @cindex setting superscript in standard font size
2855
2856 Set @var{arg} in superscript with a normal font size.
2857
2858 @lilypond[verbatim,quote]
2859 \\markup {
2860   default
2861   \\normal-size-super {
2862     superscript in standard size
2863   }
2864 }
2865 @end lilypond"
2866   (ly:stencil-translate-axis
2867    (interpret-markup layout props arg)
2868    (* 0.5 baseline-skip) Y))
2869
2870 (define-builtin-markup-command (super layout props arg)
2871   (markup?)
2872   font
2873   ((font-size 0)
2874    (baseline-skip))
2875   "  
2876 @cindex superscript text
2877
2878 Raising and lowering texts can be done with @code{\\super} and
2879 @code{\\sub}:
2880
2881 @lilypond[verbatim,quote]
2882 \\markup {
2883   E =
2884   \\concat {
2885     mc
2886     \\super
2887     2
2888   }
2889 }
2890 @end lilypond"
2891   (ly:stencil-translate-axis
2892    (interpret-markup
2893     layout
2894     (cons `((font-size . ,(- font-size 3))) props)
2895     arg)
2896    (* 0.5 baseline-skip)
2897    Y))
2898
2899 (define-builtin-markup-command (translate layout props offset arg)
2900   (number-pair? markup?)
2901   align
2902   ()
2903   "
2904 @cindex translating text
2905   
2906 This translates an object.  Its first argument is a cons of numbers.
2907
2908 @example
2909 A \\translate #(cons 2 -3) @{ B C @} D
2910 @end example
2911
2912 This moves @q{B C} 2@tie{}spaces to the right, and 3 down, relative to its
2913 surroundings.  This command cannot be used to move isolated scripts
2914 vertically, for the same reason that @code{\\raise} cannot be used for
2915 that.
2916
2917 @lilypond[verbatim,quote]
2918 \\markup {
2919   *
2920   \\translate #'(2 . 3)
2921   \\line { translated two spaces right, three up }
2922 }
2923 @end lilypond"
2924   (ly:stencil-translate (interpret-markup layout props arg)
2925                         offset))
2926
2927 (define-builtin-markup-command (sub layout props arg)
2928   (markup?)
2929   font
2930   ((font-size 0)
2931    (baseline-skip))
2932   "
2933 @cindex subscript text
2934
2935 Set @var{arg} in subscript.
2936
2937 @lilypond[verbatim,quote]
2938 \\markup {
2939   \\concat {
2940     H
2941     \\sub {
2942       2
2943     }
2944     O
2945   }
2946 }
2947 @end lilypond"
2948   (ly:stencil-translate-axis
2949    (interpret-markup
2950     layout
2951     (cons `((font-size . ,(- font-size 3))) props)
2952     arg)
2953    (* -0.5 baseline-skip)
2954    Y))
2955
2956 (define-builtin-markup-command (normal-size-sub layout props arg)
2957   (markup?)
2958   font
2959   ((baseline-skip))
2960   "
2961 @cindex setting subscript in standard font size
2962
2963 Set @var{arg} in subscript, in a normal font size.
2964
2965 @lilypond[verbatim,quote]
2966 \\markup {
2967   default
2968   \\normal-size-sub {
2969     subscript in standard size
2970   }
2971 }
2972 @end lilypond"
2973   (ly:stencil-translate-axis
2974    (interpret-markup layout props arg)
2975    (* -0.5 baseline-skip)
2976    Y))
2977 \f
2978 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2979 ;; brackets.
2980 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2981
2982 (define-builtin-markup-command (hbracket layout props arg)
2983   (markup?)
2984   graphic
2985   ()
2986   "
2987 @cindex placing horizontal brackets around text
2988   
2989 Draw horizontal brackets around @var{arg}.
2990
2991 @lilypond[verbatim,quote]
2992 \\markup {
2993   \\hbracket {
2994     \\line {
2995       one two three
2996     }
2997   }
2998 }
2999 @end lilypond"
3000   (let ((th 0.1) ;; todo: take from GROB.
3001         (m (interpret-markup layout props arg)))
3002     (bracketify-stencil m X th (* 2.5 th) th)))
3003
3004 (define-builtin-markup-command (bracket layout props arg)
3005   (markup?)
3006   graphic
3007   ()
3008   "
3009 @cindex placing vertical brackets around text
3010   
3011 Draw vertical brackets around @var{arg}.
3012
3013 @lilypond[verbatim,quote]
3014 \\markup {
3015   \\bracket {
3016     \\note #\"2.\" #UP
3017   }
3018 }
3019 @end lilypond"
3020   (let ((th 0.1) ;; todo: take from GROB.
3021         (m (interpret-markup layout props arg)))
3022     (bracketify-stencil m Y th (* 2.5 th) th)))
3023 \f
3024 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3025 ;; Delayed markup evaluation
3026 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3027
3028 (define-builtin-markup-command (page-ref layout props label gauge default)
3029   (symbol? markup? markup?)
3030   other
3031   ()
3032   "
3033 @cindex referencing page numbers in text
3034
3035 Reference to a page number. @var{label} is the label set on the referenced
3036 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
3037 the maximum width of the page number, and @var{default} the value to display
3038 when @var{label} is not found."
3039   (let* ((gauge-stencil (interpret-markup layout props gauge))
3040          (x-ext (ly:stencil-extent gauge-stencil X))
3041          (y-ext (ly:stencil-extent gauge-stencil Y)))
3042     (ly:make-stencil
3043      `(delay-stencil-evaluation
3044        ,(delay (ly:stencil-expr
3045                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
3046                        (label-page (and (list? table) (assoc label table)))
3047                        (page-number (and label-page (cdr label-page)))
3048                        (page-markup (if page-number (format "~a" page-number) default))
3049                        (page-stencil (interpret-markup layout props page-markup))
3050                        (gap (- (interval-length x-ext)
3051                                (interval-length (ly:stencil-extent page-stencil X)))))
3052                   (interpret-markup layout props
3053                                     (markup #:concat (#:hspace gap page-markup)))))))
3054      x-ext
3055      y-ext)))
3056 \f
3057 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3058 ;; Markup list commands
3059 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3060
3061 (define-public (space-lines baseline stils)
3062   (let space-stil ((stils stils)
3063                    (result (list)))
3064     (if (null? stils)
3065         (reverse! result)
3066         (let* ((stil (car stils))
3067                (dy-top (max (- (/ baseline 1.5)
3068                                (interval-bound (ly:stencil-extent stil Y) UP))
3069                             0.0))
3070                (dy-bottom (max (+ (/ baseline 3.0)
3071                                   (interval-bound (ly:stencil-extent stil Y) DOWN))
3072                                0.0))
3073                (new-stil (ly:make-stencil
3074                           (ly:stencil-expr stil)
3075                           (ly:stencil-extent stil X)
3076                           (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
3077                                    dy-bottom)
3078                                 (+ (interval-bound (ly:stencil-extent stil Y) UP)
3079                                    dy-top)))))
3080           (space-stil (cdr stils) (cons new-stil result))))))
3081
3082 (define-builtin-markup-list-command (justified-lines layout props args)
3083   (markup-list?)
3084   ((baseline-skip)
3085    wordwrap-internal-markup-list)
3086   "
3087 @cindex justifying lines of text
3088
3089 Like @code{\\justify}, but return a list of lines instead of a single markup.
3090 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
3091 @var{X}@tie{}is the number of staff spaces."
3092   (space-lines baseline-skip
3093                (interpret-markup-list layout props
3094                                       (make-wordwrap-internal-markup-list #t args))))
3095
3096 (define-builtin-markup-list-command (wordwrap-lines layout props args)
3097   (markup-list?)
3098   ((baseline-skip)
3099    wordwrap-internal-markup-list)
3100   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
3101 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
3102 where @var{X} is the number of staff spaces."
3103   (space-lines baseline-skip
3104                (interpret-markup-list layout props
3105                                       (make-wordwrap-internal-markup-list #f args))))
3106
3107 (define-builtin-markup-list-command (column-lines layout props args)
3108   (markup-list?)
3109   ((baseline-skip))
3110   "Like @code{\\column}, but return a list of lines instead of a single markup.
3111 @code{baseline-skip} determines the space between each markup in @var{args}."
3112   (space-lines (chain-assoc-get 'baseline-skip props)
3113                (interpret-markup-list layout props args)))
3114
3115 (define-builtin-markup-list-command (override-lines layout props new-prop args)
3116   (pair? markup-list?)
3117   ()
3118   "Like @code{\\override}, for markup lists."
3119   (interpret-markup-list layout (cons (list new-prop) props) args))