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