1 ;;;; This file is part of LilyPond, the GNU music typesetter.
3 ;;;; Copyright (C) 2003--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
5 ;;;; LilyPond is free software: you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation, either version 3 of the License, or
8 ;;;; (at your option) any later version.
10 ;;;; LilyPond is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;;; GNU General Public License for more details.
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
18 (defmacro*-public markup (#:rest body)
19 "The `markup' macro provides a lilypond-like syntax for building markups.
21 - #:COMMAND is used instead of \\COMMAND
22 - #:line ( ... ) is used instead of \\line { ... }
27 \\raise #0.2 \\hbracket \\bold bar
28 \\override #'(baseline-skip . 4)
29 \\bracket \\column { baz bazr bla }
33 #:raise 0.2 #:hbracket #:bold \"bar\"
34 #:override '(baseline-skip . 4)
35 #:bracket #:column (\"baz\" \"bazr\" \"bla\"))
36 Use `markup*' in a \\notemode context."
38 (car (compile-all-markup-expressions `(#:line ,body))))
42 (define (markup-join markups sep)
43 "Return line-markup of MARKUPS, joining them with markup SEP"
45 (make-line-markup (list-insert-separator markups sep))
49 (define-public interpret-markup ly:text-interface::interpret-markup)
51 (define-public (interpret-markup-list layout props markup-list)
52 (let ((stencils (list)))
55 (if (markup-command-list? m)
56 (append! (reverse! (apply (car m) layout props (cdr m)))
58 (cons (interpret-markup layout props m) stencils))))
62 (define-public (prepend-alist-chain key val chain)
63 (cons (acons key val (car chain)) (cdr chain)))
65 (define-public (stack-stencil-line space stencils)
67 (if (and (pair? stencils)
68 (ly:stencil? (car stencils)))
70 (if (and (pair? (cdr stencils))
71 (ly:stencil? (cadr stencils)))
72 (let* ((tail (stack-stencil-line space (cdr stencils)))
74 (xoff (+ space (interval-length (ly:stencil-extent head X)))))
76 (ly:stencil-translate-axis tail xoff X)))
78 (ly:make-stencil '() '(0 . 0) '(0 . 0))))
81 ;;; convert a full markup object to an approximate pure string representation
83 (define-public (markup->string m)
84 ;; markup commands with one markup argument, formatting ignored
85 (define markups-first-argument '(list
86 bold-markup box-markup caps-markup dynamic-markup finger-markup
87 fontCaps-markup huge-markup italic-markup large-markup larger-markup
88 medium-markup normal-size-sub-markup normal-size-super-markup
89 normal-text-markup normalsize-markup number-markup roman-markup
90 sans-markup simple-markup small-markup smallCaps-markup smaller-markup
91 sub-markup super-markup teeny-markup text-markup tiny-markup
92 typewriter-markup underline-markup upright-markup bracket-markup
93 circle-markup hbracket-markup parenthesize-markup rounded-box-markup
95 center-align-markup center-column-markup column-markup dir-column-markup
96 fill-line-markup justify-markup justify-string-markup left-align-markup
97 left-column-markup line-markup right-align-markup right-column-markup
98 vcenter-markup wordwrap-markup wordwrap-string-markup ))
100 ;; markup commands with markup as second argument, first argument
101 ;; specifies some formatting and is ignored
102 (define markups-second-argument '(list
103 abs-fontsize-markup fontsize-markup magnify-markup lower-markup
104 pad-around-markup pad-markup-markup pad-x-markup raise-markup
105 halign-markup hcenter-in-markup rotate-markup translate-markup
106 translate-scaled-markup with-url-markup scale-markup ))
108 ;; helper functions to handle string cons like string lists
109 (define (markup-cons->string-cons c)
110 (if (not (pair? c)) (markup->string c)
111 (cons (markup->string (car c)) (markup-cons->string-cons (cdr c)))))
112 (define (string-cons-join c)
113 (if (not (pair? c)) c
114 (string-join (list (car c) (string-cons-join (cdr c))) "")))
120 ;; handle \concat (string-join without spaces)
121 ((and (pair? m) (equal? (car m) concat-markup))
122 (string-cons-join (markup-cons->string-cons (cadr m))) )
124 ;; markup functions with the markup as first arg
125 ((member (car m) (primitive-eval markups-first-argument))
126 (markup->string (cadr m)))
128 ;; markup functions with markup as second arg
129 ((member (car m) (primitive-eval markups-second-argument))
130 (markup->string (cddr m)))
132 ;; ignore all other markup functions
133 ((markup-function? (car m)) "")
135 ;; handle markup lists
137 (string-join (map markup->string m) " "))
139 (else "ERROR, unable to extract string from markup")))