gub: patches/lilypond-guile-2.0.patch annotate

annotate patches/lilypond-guile-2.0.patch @ 6500:2c57f92179f2

guile: more build and mingw patches.

author	Jan Nieuwenhuizen <janneke@gnu.org>
date	Thu, 17 Mar 2011 21:59:08 +0100
parents
children

rev	line source
6500 2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1 diff --git a/ly/toc-init.ly b/ly/toc-init.ly
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	2 index 488e22b..677bbb0 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	3 --- a/ly/toc-init.ly
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	4 +++ b/ly/toc-init.ly
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	5 @@ -34,26 +34,26 @@
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	6 tocItemWithDotsMarkup = \markup \fill-with-pattern #1 #RIGHT .
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	7 \fromproperty #'toc:text \fromproperty #'toc:page
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	8
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	9 -#(define-markup-list-command (table-of-contents layout props) ()
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	10 - ( _i "Outputs the table of contents, using the paper variable
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	11 -@code{tocTitleMarkup} for its title, then the list of lines
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	12 -built using the @code{tocItem} music function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	13 -Usage: @code{\\markuplines \\table-of-contents}" )
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	14 - (cons (interpret-markup layout props
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	15 - (ly:output-def-lookup layout 'tocTitleMarkup))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	16 - (space-lines (chain-assoc-get 'baseline-skip props)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	17 - (map (lambda (toc-item)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	18 - (let ((label (car toc-item))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	19 - (toc-markup (cadr toc-item))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	20 - (text (caddr toc-item)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	21 - (interpret-markup
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	22 - layout
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	23 - (cons (list (cons 'toc:page
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	24 - (markup #:page-ref label "XXX" "?"))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	25 - (cons 'toc:text text))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	26 - props)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	27 - (ly:output-def-lookup layout toc-markup))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	28 - (toc-items)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	29 +%#(define-markup-list-command (table-of-contents layout props) ()
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	30 +% ( _i "Outputs the table of contents, using the paper variable
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	31 +%@code{tocTitleMarkup} for its title, then the list of lines
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	32 +%built using the @code{tocItem} music function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	33 +%Usage: @code{\\markuplines \\table-of-contents}" )
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	34 +% (cons (interpret-markup layout props
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	35 +% (ly:output-def-lookup layout 'tocTitleMarkup))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	36 +% (space-lines (chain-assoc-get 'baseline-skip props)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	37 +% (map (lambda (toc-item)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	38 +% (let ((label (car toc-item))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	39 +% (toc-markup (cadr toc-item))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	40 +% (text (caddr toc-item)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	41 +% (interpret-markup
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	42 +% layout
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	43 +% (cons (list (cons 'toc:page
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	44 +% (markup #:page-ref label "XXX" "?"))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	45 +% (cons 'toc:text text))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	46 +% props)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	47 +% (ly:output-def-lookup layout toc-markup))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	48 +% (toc-items)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	49
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	50 tocItem =
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	51 #(define-music-function (parser location text) (markup?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	52 diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	53 index 5de7fdc..c52b953 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	54 --- a/scm/define-markup-commands.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	55 +++ b/scm/define-markup-commands.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	56 @@ -2419,32 +2419,6 @@ normal text font, no matter what font was used earlier.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	57 ;; symbols.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	59
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	60 -(define-markup-command (musicglyph layout props glyph-name)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	61 - (string?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	62 - #:category music
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	63 - "@var{glyph-name} is converted to a musical symbol; for example,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	64 -@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	65 -the music font. See @ruser{The Feta font} for a complete listing of
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	66 -the possible glyphs.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	67 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	68 -@lilypond[verbatim,quote]
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	69 -\\markup {
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	70 - \\musicglyph #\"f\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	71 - \\musicglyph #\"rests.2\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	72 - \\musicglyph #\"clefs.G_change\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	73 -}
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	74 -@end lilypond"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	75 - (let* ((font (ly:paper-get-font layout
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	76 - (cons '((font-encoding . fetaMusic)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	77 - (font-name . #f))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	78 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	79 - props)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	80 - (glyph (ly:font-get-glyph font glyph-name)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	81 - (if (null? (ly:stencil-expr glyph))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	82 - (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	83 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	84 - glyph))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	85 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	86 (define-markup-command (doublesharp layout props)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	87 ()
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	88 #:category music
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	89 @@ -2612,6 +2586,33 @@ Use the filled head if @var{filled} is specified.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	90 props))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	91 name)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	92
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	93 +(define-markup-command (musicglyph layout props glyph-name)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	94 + (string?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	95 + #:category music
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	96 + "@var{glyph-name} is converted to a musical symbol; for example,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	97 +@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	98 +the music font. See @ruser{The Feta font} for a complete listing of
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	99 +the possible glyphs.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	100 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	101 +@lilypond[verbatim,quote]
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	102 +\\markup {
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	103 + \\musicglyph #\"f\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	104 + \\musicglyph #\"rests.2\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	105 + \\musicglyph #\"clefs.G_change\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	106 +}
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	107 +@end lilypond"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	108 + (let* ((font (ly:paper-get-font layout
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	109 + (cons '((font-encoding . fetaMusic)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	110 + (font-name . #f))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	111 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	112 + props)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	113 + (glyph (ly:font-get-glyph font glyph-name)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	114 + (if (null? (ly:stencil-expr glyph))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	115 + (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	116 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	117 + glyph))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	118 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	119 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	120 (define-markup-command (lookup layout props glyph-name)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	121 (string?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	122 #:category other
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	123 @@ -3137,7 +3138,7 @@ and/or @code{extra-offset} properties.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	124 Make a fraction of two markups.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	125 @lilypond[verbatim,quote]
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	126 \\markup {
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	127 - π ≈
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	128 + pi is
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	129 \\fraction 355 113
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	130 }
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	131 @end lilypond"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	132 @@ -3575,3 +3576,13 @@ where @var{X} is the number of staff spaces."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	133 (pair? markup-list?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	134 "Like @code{\\override}, for markup lists."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	135 (interpret-markup-list layout (cons (list new-prop) props) args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	136 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	137 +; Draws a circle around markup if (= trigger 0.5)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	138 +(define-markup-command
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	139 + (conditional-circle-markup layout props trigger in-markup)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	140 + (number? markup?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	141 + (interpret-markup layout props
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	142 + (if (eqv? trigger 0.5)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	143 + (markup #:circle (markup in-markup))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	144 + (markup in-markup))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	145 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	146 diff --git a/scm/define-woodwind-diagrams.scm b/scm/define-woodwind-diagrams.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	147 index 29825fd..de28080 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	148 --- a/scm/define-woodwind-diagrams.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	149 +++ b/scm/define-woodwind-diagrams.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	150 @@ -256,15 +256,6 @@ returns @samp{1/3}."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	151
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	152 ;;; Commands for text layout
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	153
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	154 -; Draws a circle around markup if (= trigger 0.5)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	155 -(define-markup-command
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	156 - (conditional-circle-markup layout props trigger in-markup)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	157 - (number? markup?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	158 - (interpret-markup layout props
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	159 - (if (eqv? trigger 0.5)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	160 - (markup #:circle (markup in-markup))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	161 - (markup in-markup))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	162 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	163 ; Makes a list of named-keys
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	164 (define (make-name-keylist input-list key-list font-size)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	165 (map (lambda (x y)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	166 diff --git a/scm/document-identifiers.scm b/scm/document-identifiers.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	167 index ffccf72..9ea707e 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	168 --- a/scm/document-identifiers.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	169 +++ b/scm/document-identifiers.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	170 @@ -22,19 +22,12 @@
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	171 ((name-sym (car music-func-pair))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	172 (music-func (cdr music-func-pair))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	173 (func (ly:music-function-extract music-func))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	174 - (arg-names
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	175 - (map symbol->string
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	176 - (cddr (cadr (procedure-source func)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	177 + (arg-names "")
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	178 (doc (procedure-documentation func))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	179 (sign (object-property func 'music-function-signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	180 (type-names (map type-name sign))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	181
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	182 - (signature-str
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	183 - (string-join
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	184 - (map (lambda (x) (format "@var{~a} (~a)"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	185 - (car x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	186 - (cadr x)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	187 - (zip arg-names type-names)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	188 + (signature-str ""))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	189 (format
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	190 "@item @code{~a}~a~a
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	191 @findex ~a
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	192 diff --git a/scm/document-markup.scm b/scm/document-markup.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	193 index c348e66..b99165b 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	194 --- a/scm/document-markup.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	195 +++ b/scm/document-markup.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	196 @@ -46,10 +46,7 @@
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	197 (f-name (symbol->string (procedure-name func)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	198 (c-name (regexp-substitute/global #f "-markup(-list)?$" f-name 'pre "" 'post))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	199 (sig (object-property func 'markup-signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	200 - (arg-names (let ((arg-list (cadr (procedure-source func))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	201 - (if (list? arg-list)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	202 - (map symbol->string (cddr arg-list))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	203 - (make-list (length sig) "arg"))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	204 + (arg-names (make-list (length sig) "arg"))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	205 (sig-type-names (map type-name sig))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	206 (signature-str
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	207 (string-join
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	208 @@ -79,11 +76,11 @@
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	209 (let* ((category-string (symbol->string category))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	210 (category-name (string-capitalize (regexp-substitute/global #f
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	211 "-" category-string 'pre " " 'post)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	212 - (markup-functions (hash-fold (lambda (markup-function dummy functions)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	213 - (cons markup-function functions))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	214 - '()
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	215 - (hashq-ref markup-functions-by-category
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	216 - category))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	217 + (markup-functions (hash-fold (lambda (markup-function dummy functions)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	218 + (cons markup-function functions))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	219 + '()
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	220 + (hashq-ref markup-functions-by-category
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	221 + category))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	222 (make <texi-node>
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	223 #:appendix #t
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	224 #:name category-name
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	225 diff --git a/scm/lily-library.scm b/scm/lily-library.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	226 index 0e2c810..2a5c760 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	227 --- a/scm/lily-library.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	228 +++ b/scm/lily-library.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	229 @@ -746,6 +746,35 @@ Handy for debugging, possibly turned off."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	230
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	231 (reverse matches))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	232
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	233 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	234 +;; Color
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	235 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	236 +(define-public (color? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	237 + (and (list? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	238 + (= 3 (length x))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	239 + (apply eq? #t (map number? x))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	240 + (apply eq? #t (map (lambda (y) (<= 0 y 1)) x))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	241 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	242 +(define-public (rgb-color r g b) (list r g b))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	243 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	244 +; predefined colors
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	245 +(define-public black '(0.0 0.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	246 +(define-public white '(1.0 1.0 1.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	247 +(define-public red '(1.0 0.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	248 +(define-public green '(0.0 1.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	249 +(define-public blue '(0.0 0.0 1.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	250 +(define-public cyan '(0.0 1.0 1.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	251 +(define-public magenta '(1.0 0.0 1.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	252 +(define-public yellow '(1.0 1.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	253 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	254 +(define-public grey '(0.5 0.5 0.5))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	255 +(define-public darkred '(0.5 0.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	256 +(define-public darkgreen '(0.0 0.5 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	257 +(define-public darkblue '(0.0 0.0 0.5))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	258 +(define-public darkcyan '(0.0 0.5 0.5))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	259 +(define-public darkmagenta '(0.5 0.0 0.5))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	260 +(define-public darkyellow '(0.5 0.5 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	261 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	262 ;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	263 ;; other
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	264
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	265 diff --git a/scm/lily.scm b/scm/lily.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	266 index 203a449..3558ba7 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	267 --- a/scm/lily.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	268 +++ b/scm/lily.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	269 @@ -404,29 +404,28 @@ LilyPond safe mode. The syntax is the same as `define*-public'."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	270 "define-music-callbacks.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	271 "define-music-types.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	272 "define-note-names.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	273 - "output-lib.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	274 "c++.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	275 - "chord-ignatzek-names.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	276 "chord-entry.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	277 - "chord-generic-names.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	278 "stencil.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	279 + "markup-macros.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	280 + "define-markup-commands.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	281 "markup.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	282 "modal-transforms.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	283 + "output-lib.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	284 + "chord-generic-names.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	285 + "chord-ignatzek-names.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	286 "music-functions.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	287 "part-combiner.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	288 "autochange.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	289 "define-music-properties.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	290 "time-signature-settings.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	291 "auto-beam.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	292 + "chord-name.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	293 "bezier-tools.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	294 "parser-ly-from-scheme.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	295 "ly-syntax-constructors.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	296
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	297 "define-context-properties.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	298 - ;; guile 1.9 wants markups defined before referenced
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	299 - "define-markup-commands.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	300 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	301 - "chord-name.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	302 "translation-functions.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	303 "script.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	304 "midi.scm"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	305 diff --git a/scm/markup-macros.scm b/scm/markup-macros.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	306 new file mode 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	307 index 0000000..e1f26e6
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	308 --- /dev/null
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	309 +++ b/scm/markup-macros.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	310 @@ -0,0 +1,479 @@
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	311 +;;;; This file is part of LilyPond, the GNU music typesetter.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	312 +;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	313 +;;;; Copyright (C) 2003--2010 Han-Wen Nienhuys <hanwen@xs4all.nl>
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	314 +;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	315 +;;;; LilyPond is free software: you can redistribute it and/or modify
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	316 +;;;; it under the terms of the GNU General Public License as published by
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	317 +;;;; the Free Software Foundation, either version 3 of the License, or
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	318 +;;;; (at your option) any later version.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	319 +;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	320 +;;;; LilyPond is distributed in the hope that it will be useful,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	321 +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	322 +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	323 +;;;; GNU General Public License for more details.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	324 +;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	325 +;;;; You should have received a copy of the GNU General Public License
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	326 +;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	327 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	328 +"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	329 +Internally markup is stored as lists, whose head is a function.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	330 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	331 + (FUNCTION ARG1 ARG2 ... )
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	332 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	333 +When the markup is formatted, then FUNCTION is called as follows
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	334 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	335 + (FUNCTION GROB PROPS ARG1 ARG2 ... )
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	336 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	337 +GROB is the current grob, PROPS is a list of alists, and ARG1.. are
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	338 +the rest of the arguments.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	339 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	340 +The function should return a stencil (i.e. a formatted, ready to
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	341 +print object).
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	342 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	343 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	344 +To add a markup command, use the define-markup-command utility.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	345 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	346 + (define-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	347 + \"my command usage and description\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	348 + ...function body...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	349 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	350 +The command is now available in markup mode, e.g.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	351 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	352 + \\markup { .... \\MYCOMMAND #1 argument ... }
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	353 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	354 +" ; "
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	355 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	356 +;;;;;;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	357 +;;; markup definer utilities
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	358 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	359 +;; For documentation purposes
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	360 +;; category -> markup functions
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	361 +(define-public markup-functions-by-category (make-hash-table 150))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	362 +;; markup function -> used properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	363 +(define-public markup-functions-properties (make-weak-key-hash-table 151))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	364 +;; List of markup list functions
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	365 +(define-public markup-list-functions (make-weak-key-hash-table 151))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	366 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	367 +(use-modules (ice-9 optargs))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	368 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	369 +(defmacro*-public define-markup-command
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	370 + (command-and-args signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	371 + #:key (category '()) (properties '())
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	372 + #:rest body)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	373 + "
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	374 +* Define a COMMAND-markup function after command-and-args and body,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	375 +register COMMAND-markup and its signature,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	376 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	377 +* add COMMAND-markup to markup-functions-by-category,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	378 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	379 +* sets COMMAND-markup markup-signature object property,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	380 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	381 +* define a make-COMMAND-markup function.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	382 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	383 +Syntax:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	384 + (define-markup-command (COMMAND layout props . arguments)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	385 + argument-types
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	386 + [ #:properties properties ]
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	387 + \"documentation string\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	388 + ...command body...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	389 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	390 +where:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	391 + `argument-types' is a list of type predicates for arguments
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	392 + `properties' a list of (property default-value) lists
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	393 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	394 +The specified properties are available as let-bound variables in the
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	395 +command body, using the respective `default-value' as fallback in case
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	396 +`property' is not found in `props'. `props' itself is left unchanged:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	397 +if you want defaults specified in that manner passed down into other
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	398 +markup functions, you need to adjust `props' yourself.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	399 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	400 +The autogenerated documentation makes use of some optional
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	401 +specifications that are otherwise ignored:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	402 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	403 +After `argument-types', you may also specify
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	404 + [ #:category category ]
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	405 +where:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	406 + `category' is either a symbol or a symbol list specifying the
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	407 + category for this markup command in the docs.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	408 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	409 +As an element of the `properties' list, you may directly use a
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	410 +COMMANDx-markup symbol instead of a `(prop value)' list to indicate
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	411 +that this markup command is called by the newly defined command,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	412 +adding its properties to the documented properties of the new
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	413 +command. There is no protection against circular definitions.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	414 +"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	415 + (let* ((command (car command-and-args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	416 + (args (cdr command-and-args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	417 + (command-name (string->symbol (format #f "~a-markup" command)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	418 + (make-markup-name (string->symbol (format #f "make-~a-markup" command))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	419 + (while (and (pair? body) (keyword? (car body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	420 + (set! body (cddr body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	421 + `(begin
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	422 + ;; define the COMMAND-markup function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	423 + ,(let* ((documentation (if (string? (car body))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	424 + (list (car body))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	425 + '()))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	426 + (real-body (if (or (null? documentation)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	427 + (null? (cdr body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	428 + body (cdr body))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	429 + `(define-public (,command-name ,@args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	430 + ,@documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	431 + (let ,(map (lambda (prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	432 + (let ((prop (car prop-spec))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	433 + (default-value (if (null? (cdr prop-spec))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	434 + #f
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	435 + (cadr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	436 + (props (cadr args)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	437 + `(,prop (chain-assoc-get ',prop ,props ,default-value))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	438 + (filter pair? properties))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	439 + ,@real-body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	440 + (set! (markup-command-signature ,command-name) (list ,@signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	441 + ;; Register the new function, for markup documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	442 + ,@(map (lambda (category)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	443 + `(hashq-set!
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	444 + (or (hashq-ref markup-functions-by-category ',category)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	445 + (let ((hash (make-weak-key-hash-table 151)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	446 + (hashq-set! markup-functions-by-category ',category
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	447 + hash)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	448 + hash))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	449 + ,command-name #t))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	450 + (if (list? category) category (list category)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	451 + ;; Used properties, for markup documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	452 + (hashq-set! markup-functions-properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	453 + ,command-name
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	454 + (list ,@(map (lambda (prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	455 + (cond ((symbol? prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	456 + prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	457 + ((not (null? (cdr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	458 + `(list ',(car prop-spec) ,(cadr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	459 + (else
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	460 + `(list ',(car prop-spec)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	461 + (if (pair? args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	462 + properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	463 + (list)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	464 + ;; define the make-COMMAND-markup function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	465 + (define-public (,make-markup-name . args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	466 + (let ((sig (list ,@signature)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	467 + (make-markup ,command-name ,(symbol->string make-markup-name) sig args))))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	468 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	469 +(defmacro*-public define-markup-list-command
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	470 + (command-and-args signature #:key (properties '()) #:rest body)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	471 + "Same as `define-markup-command', but defines a command that, when
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	472 +interpreted, returns a list of stencils instead of a single one"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	473 + (let* ((command (car command-and-args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	474 + (args (cdr command-and-args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	475 + (command-name (string->symbol (format #f "~a-markup-list" command)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	476 + (make-markup-name (string->symbol (format #f "make-~a-markup-list" command))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	477 + (while (and (pair? body) (keyword? (car body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	478 + (set! body (cddr body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	479 + `(begin
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	480 + ;; define the COMMAND-markup-list function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	481 + ,(let* ((documentation (if (string? (car body))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	482 + (list (car body))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	483 + '()))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	484 + (real-body (if (or (null? documentation)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	485 + (null? (cdr body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	486 + body (cdr body))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	487 + `(define-public (,command-name ,@args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	488 + ,@documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	489 + (let ,(map (lambda (prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	490 + (let ((prop (car prop-spec))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	491 + (default-value (if (null? (cdr prop-spec))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	492 + #f
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	493 + (cadr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	494 + (props (cadr args)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	495 + `(,prop (chain-assoc-get ',prop ,props ,default-value))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	496 + (filter pair? properties))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	497 + ,@real-body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	498 + (set! (markup-command-signature ,command-name) (list ,@signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	499 + ;; add the command to markup-list-function-list, for markup documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	500 + (hashq-set! markup-list-functions ,command-name #t)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	501 + ;; Used properties, for markup documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	502 + (hashq-set! markup-functions-properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	503 + ,command-name
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	504 + (list ,@(map (lambda (prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	505 + (cond ((symbol? prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	506 + prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	507 + ((not (null? (cdr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	508 + `(list ',(car prop-spec) ,(cadr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	509 + (else
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	510 + `(list ',(car prop-spec)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	511 + (if (pair? args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	512 + properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	513 + (list)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	514 + ;; it's a markup-list command:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	515 + (set-object-property! ,command-name 'markup-list-command #t)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	516 + ;; define the make-COMMAND-markup-list function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	517 + (define-public (,make-markup-name . args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	518 + (let ((sig (list ,@signature)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	519 + (list (make-markup ,command-name
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	520 + ,(symbol->string make-markup-name) sig args)))))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	521 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	522 +;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	523 +;;; Utilities for storing and accessing markup commands signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	524 +;;; Examples:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	525 +;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	526 +;;; (set! (markup-command-signature raise-markup) (list number? markup?))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	527 +;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	528 +;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	529 +;;; (markup-command-signature raise-markup)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	530 +;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	531 +;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	532 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	533 +(define-public (markup-command-signature-ref markup-command)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	534 + "Return markup-command's signature (the 'markup-signature object property)"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	535 + (object-property markup-command 'markup-signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	536 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	537 +(define-public (markup-command-signature-set! markup-command signature)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	538 + "Set markup-command's signature (as object property)"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	539 + (set-object-property! markup-command 'markup-signature signature)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	540 + signature)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	541 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	542 +(define-public markup-command-signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	543 + (make-procedure-with-setter markup-command-signature-ref
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	544 + markup-command-signature-set!))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	545 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	546 +;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	547 +;;; markup type predicates
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	548 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	549 +(define (markup-function? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	550 + (and (markup-command-signature x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	551 + (not (object-property x 'markup-list-command))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	552 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	553 +(define (markup-list-function? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	554 + (and (markup-command-signature x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	555 + (object-property x 'markup-list-command)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	556 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	557 +(define-public (markup-command-list? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	558 + "Determine if `x' is a markup command list, ie. a list composed of
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	559 +a markup list function and its arguments."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	560 + (and (pair? x) (markup-list-function? (car x))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	561 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	562 +(define-public (markup-list? arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	563 + "Return a true value if `x' is a list of markups or markup command lists."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	564 + (define (markup-list-inner? lst)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	565 + (or (null? lst)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	566 + (and (or (markup? (car lst)) (markup-command-list? (car lst)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	567 + (markup-list-inner? (cdr lst)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	568 + (not (not (and (list? arg) (markup-list-inner? arg)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	569 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	570 +(define (markup-argument-list? signature arguments)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	571 + "Typecheck argument list."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	572 + (if (and (pair? signature) (pair? arguments))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	573 + (and ((car signature) (car arguments))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	574 + (markup-argument-list? (cdr signature) (cdr arguments)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	575 + (and (null? signature) (null? arguments))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	576 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	577 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	578 +(define (markup-argument-list-error signature arguments number)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	579 + "return (ARG-NR TYPE-EXPECTED ARG-FOUND) if an error is detected, or
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	580 +#f is no error found.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	581 +"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	582 + (if (and (pair? signature) (pair? arguments))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	583 + (if (not ((car signature) (car arguments)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	584 + (list number (type-name (car signature)) (car arguments))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	585 + (markup-argument-list-error (cdr signature) (cdr arguments) (+ 1 number)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	586 + #f))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	587 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	588 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	589 +;; full recursive typecheck.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	590 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	591 +(define (markup-typecheck? arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	592 + (or (string? arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	593 + (and (pair? arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	594 + (markup-function? (car arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	595 + (markup-argument-list? (markup-command-signature (car arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	596 + (cdr arg)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	597 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	598 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	599 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	600 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	601 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	602 +(define (markup-thrower-typecheck arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	603 + "typecheck, and throw an error when something amiss.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	604 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	605 +Uncovered - cheap-markup? is used."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	606 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	607 + (cond ((string? arg) #t)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	608 + ((not (pair? arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	609 + (throw 'markup-format "Not a pair" arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	610 + ((not (markup-function? (car arg)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	611 + (throw 'markup-format "Not a markup function " (car arg)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	612 + ((not (markup-argument-list? (markup-command-signature (car arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	613 + (cdr arg)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	614 + (throw 'markup-format "Arguments failed typecheck for " arg)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	615 + #t)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	616 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	617 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	618 +;; good enough if you only use make-XXX-markup functions.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	619 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	620 +(define (cheap-markup? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	621 + (or (string? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	622 + (and (pair? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	623 + (markup-function? (car x)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	624 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	625 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	626 +;; replace by markup-thrower-typecheck for more detailed diagnostics.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	627 +;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	628 +(define-public markup? cheap-markup?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	629 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	630 +(define-public (make-markup markup-function make-name signature args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	631 + " Construct a markup object from MARKUP-FUNCTION and ARGS. Typecheck
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	632 +against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	633 +"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	634 + (let* ((arglen (length args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	635 + (siglen (length signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	636 + (error-msg (if (and (> siglen 0) (> arglen 0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	637 + (markup-argument-list-error signature args 1)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	638 + #f)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	639 + (if (or (not (= arglen siglen)) (< siglen 0) (< arglen 0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	640 + (ly:error (string-append make-name ": "
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	641 + (_ "Wrong number of arguments. Expect: ~A, found ~A: ~S"))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	642 + siglen arglen args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	643 + (if error-msg
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	644 + (ly:error
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	645 + (string-append
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	646 + make-name ": "
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	647 + (_ "Invalid argument in position ~A. Expect: ~A, found: ~S."))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	648 + (car error-msg) (cadr error-msg)(caddr error-msg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	649 + (cons markup-function args))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	650 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	651 +;;;;;;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	652 +;;; markup constructors
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	653 +;;; lilypond-like syntax for markup construction in scheme.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	654 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	655 +(use-modules (ice-9 receive))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	656 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	657 +(defmacro-public markup (#:rest body)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	658 + "Same as `markup', for use in a \\notes block."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	659 + `(ly:export (markup ,@body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	660 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	661 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	662 +(define (compile-all-markup-expressions expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	663 + "Return a list of canonical markups expressions, e.g.:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	664 + (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	665 + ===>
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	666 + ((make-COMMAND1-markup arg11 arg12)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	667 + (make-COMMAND2-markup arg21 arg22 arg23) ...)"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	668 + (do ((rest expr rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	669 + (markps '() markps))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	670 + ((null? rest) (reverse markps))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	671 + (receive (m r) (compile-markup-expression rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	672 + (set! markps (cons m markps))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	673 + (set! rest r))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	674 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	675 +(define (keyword->make-markup key)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	676 + "Transform a keyword, e.g. #:COMMAND, in a make-COMMAND-markup symbol."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	677 + (string->symbol (string-append "make-" (symbol->string (keyword->symbol key)) "-markup")))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	678 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	679 +(define (compile-markup-expression expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	680 + "Return two values: the first complete canonical markup expression
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	681 + found in `expr', e.g. (make-COMMAND-markup arg1 arg2 ...),
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	682 + and the rest expression."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	683 + (cond ((and (pair? expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	684 + (keyword? (car expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	685 + ;; expr === (#:COMMAND arg1 ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	686 + (let ((command (symbol->string (keyword->symbol (car expr)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	687 + (if (not (pair? (lookup-markup-command command)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	688 + (ly:error (_ "Not a markup command: ~A") command))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	689 + (let* ((sig (markup-command-signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	690 + (car (lookup-markup-command command))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	691 + (sig-len (length sig)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	692 + (do ((i 0 (1+ i))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	693 + (args '() args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	694 + (rest (cdr expr) rest))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	695 + ((>= i sig-len)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	696 + (values (cons (keyword->make-markup (car expr)) (reverse args)) rest))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	697 + (cond ((eqv? (list-ref sig i) markup-list?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	698 + ;; (car rest) is a markup list
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	699 + (set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	700 + (set! rest (cdr rest)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	701 + (else
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	702 + ;; pick up one arg in `rest'
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	703 + (receive (a r) (compile-markup-arg rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	704 + (set! args (cons a args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	705 + (set! rest r))))))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	706 + ((and (pair? expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	707 + (pair? (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	708 + (keyword? (caar expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	709 + ;; expr === ((#:COMMAND arg1 ...) ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	710 + (receive (m r) (compile-markup-expression (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	711 + (values m (cdr expr))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	712 + ((and (pair? expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	713 + (string? (car expr))) ;; expr === ("string" ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	714 + (values `(make-simple-markup ,(car expr)) (cdr expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	715 + (else
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	716 + ;; expr === (symbol ...) or ((funcall ...) ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	717 + (values (car expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	718 + (cdr expr)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	719 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	720 +(define (compile-all-markup-args expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	721 + "Transform `expr' into markup arguments"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	722 + (do ((rest expr rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	723 + (args '() args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	724 + ((null? rest) (reverse args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	725 + (receive (a r) (compile-markup-arg rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	726 + (set! args (cons a args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	727 + (set! rest r))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	728 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	729 +(define (compile-markup-arg expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	730 + "Return two values: the desired markup argument, and the rest arguments"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	731 + (cond ((null? expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	732 + ;; no more args
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	733 + (values '() '()))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	734 + ((keyword? (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	735 + ;; expr === (#:COMMAND ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	736 + ;; ==> build and return the whole markup expression
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	737 + (compile-markup-expression expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	738 + ((and (pair? (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	739 + (keyword? (caar expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	740 + ;; expr === ((#:COMMAND ...) ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	741 + ;; ==> build and return the whole markup expression(s)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	742 + ;; found in (car expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	743 + (receive (markup-expr rest-expr) (compile-markup-expression (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	744 + (if (null? rest-expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	745 + (values markup-expr (cdr expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	746 + (values `(list ,markup-expr ,@(compile-all-markup-args rest-expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	747 + (cdr expr)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	748 + ((and (pair? (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	749 + (pair? (caar expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	750 + ;; expr === (((foo ...) ...) ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	751 + (values (cons 'list (compile-all-markup-args (car expr))) (cdr expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	752 + (else (values (car expr) (cdr expr)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	753 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	754 +(define (lookup-markup-command-aux symbol)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	755 + (let ((proc (catch 'misc-error
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	756 + (lambda ()
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	757 + (module-ref (current-module) symbol))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	758 + (lambda (key . args) #f))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	759 + (and (procedure? proc) proc)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	760 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	761 +(define-public (lookup-markup-command code)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	762 + (let ((proc (lookup-markup-command-aux
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	763 + (string->symbol (format #f "~a-markup" code)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	764 + (and proc (markup-function? proc)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	765 + (cons proc (markup-command-signature proc)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	766 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	767 +(define-public (lookup-markup-list-command code)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	768 + (let ((proc (lookup-markup-command-aux
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	769 + (string->symbol (format #f "~a-markup-list" code)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	770 + (and proc (markup-list-function? proc)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	771 + (cons proc (markup-command-signature proc)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	772 +
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	773 +;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	774 +;;; used in parser.yy to map a list of markup commands on markup arguments
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	775 +(define-public (map-markup-command-list commands markups)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	776 + "`markups' being a list of markups, eg (markup1 markup2 markup3),
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	777 +and `commands' a list of commands with their scheme arguments, in reverse order,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	778 +eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	779 + ((bold (raise 4 (italic markup1)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	780 + (bold (raise 4 (italic markup2)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	781 + (bold (raise 4 (italic markup3))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	782 +"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	783 + (map-in-order (lambda (arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	784 + (let ((result arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	785 + (for-each (lambda (cmd)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	786 + (set! result (append cmd (list result))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	787 + commands)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	788 + result))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	789 + markups))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	790 diff --git a/scm/markup.scm b/scm/markup.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	791 index 6bd9fd6..f6ba141 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	792 --- a/scm/markup.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	793 +++ b/scm/markup.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	794 @@ -15,227 +15,6 @@
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	795 ;;;; You should have received a copy of the GNU General Public License
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	796 ;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	797
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	798 -"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	799 -Internally markup is stored as lists, whose head is a function.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	800 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	801 - (FUNCTION ARG1 ARG2 ... )
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	802 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	803 -When the markup is formatted, then FUNCTION is called as follows
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	804 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	805 - (FUNCTION GROB PROPS ARG1 ARG2 ... )
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	806 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	807 -GROB is the current grob, PROPS is a list of alists, and ARG1.. are
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	808 -the rest of the arguments.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	809 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	810 -The function should return a stencil (i.e. a formatted, ready to
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	811 -print object).
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	812 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	813 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	814 -To add a markup command, use the define-markup-command utility.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	815 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	816 - (define-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	817 - \"my command usage and description\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	818 - ...function body...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	819 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	820 -The command is now available in markup mode, e.g.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	821 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	822 - \\markup { .... \\MYCOMMAND #1 argument ... }
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	823 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	824 -" ; "
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	825 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	826 -;;;;;;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	827 -;;; markup definer utilities
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	828 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	829 -;; For documentation purposes
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	830 -;; category -> markup functions
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	831 -(define-public markup-functions-by-category (make-hash-table 150))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	832 -;; markup function -> used properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	833 -(define-public markup-functions-properties (make-weak-key-hash-table 151))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	834 -;; List of markup list functions
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	835 -(define-public markup-list-functions (make-weak-key-hash-table 151))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	836 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	837 -(use-modules (ice-9 optargs))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	838 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	839 -(defmacro*-public define-markup-command
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	840 - (command-and-args signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	841 - #:key (category '()) (properties '())
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	842 - #:rest body)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	843 - "
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	844 -* Define a COMMAND-markup function after command-and-args and body,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	845 -register COMMAND-markup and its signature,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	846 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	847 -* add COMMAND-markup to markup-functions-by-category,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	848 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	849 -* sets COMMAND-markup markup-signature object property,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	850 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	851 -* define a make-COMMAND-markup function.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	852 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	853 -Syntax:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	854 - (define-markup-command (COMMAND layout props . arguments)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	855 - argument-types
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	856 - [ #:properties properties ]
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	857 - \"documentation string\"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	858 - ...command body...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	859 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	860 -where:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	861 - `argument-types' is a list of type predicates for arguments
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	862 - `properties' a list of (property default-value) lists
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	863 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	864 -The specified properties are available as let-bound variables in the
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	865 -command body, using the respective `default-value' as fallback in case
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	866 -`property' is not found in `props'. `props' itself is left unchanged:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	867 -if you want defaults specified in that manner passed down into other
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	868 -markup functions, you need to adjust `props' yourself.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	869 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	870 -The autogenerated documentation makes use of some optional
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	871 -specifications that are otherwise ignored:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	872 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	873 -After `argument-types', you may also specify
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	874 - [ #:category category ]
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	875 -where:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	876 - `category' is either a symbol or a symbol list specifying the
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	877 - category for this markup command in the docs.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	878 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	879 -As an element of the `properties' list, you may directly use a
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	880 -COMMANDx-markup symbol instead of a `(prop value)' list to indicate
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	881 -that this markup command is called by the newly defined command,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	882 -adding its properties to the documented properties of the new
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	883 -command. There is no protection against circular definitions.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	884 -"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	885 - (let* ((command (car command-and-args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	886 - (args (cdr command-and-args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	887 - (command-name (string->symbol (format #f "~a-markup" command)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	888 - (make-markup-name (string->symbol (format #f "make-~a-markup" command))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	889 - (while (and (pair? body) (keyword? (car body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	890 - (set! body (cddr body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	891 - `(begin
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	892 - ;; define the COMMAND-markup function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	893 - ,(let* ((documentation (if (string? (car body))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	894 - (list (car body))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	895 - '()))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	896 - (real-body (if (or (null? documentation)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	897 - (null? (cdr body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	898 - body (cdr body))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	899 - `(define-public (,command-name ,@args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	900 - ,@documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	901 - (let ,(map (lambda (prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	902 - (let ((prop (car prop-spec))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	903 - (default-value (if (null? (cdr prop-spec))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	904 - #f
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	905 - (cadr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	906 - (props (cadr args)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	907 - `(,prop (chain-assoc-get ',prop ,props ,default-value))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	908 - (filter pair? properties))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	909 - ,@real-body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	910 - (set! (markup-command-signature ,command-name) (list ,@signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	911 - ;; Register the new function, for markup documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	912 - ,@(map (lambda (category)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	913 - `(hashq-set!
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	914 - (or (hashq-ref markup-functions-by-category ',category)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	915 - (let ((hash (make-weak-key-hash-table 151)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	916 - (hashq-set! markup-functions-by-category ',category
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	917 - hash)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	918 - hash))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	919 - ,command-name #t))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	920 - (if (list? category) category (list category)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	921 - ;; Used properties, for markup documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	922 - (hashq-set! markup-functions-properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	923 - ,command-name
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	924 - (list ,@(map (lambda (prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	925 - (cond ((symbol? prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	926 - prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	927 - ((not (null? (cdr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	928 - `(list ',(car prop-spec) ,(cadr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	929 - (else
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	930 - `(list ',(car prop-spec)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	931 - (if (pair? args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	932 - properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	933 - (list)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	934 - ;; define the make-COMMAND-markup function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	935 - (define-public (,make-markup-name . args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	936 - (let ((sig (list ,@signature)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	937 - (make-markup ,command-name ,(symbol->string make-markup-name) sig args))))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	938 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	939 -(defmacro*-public define-markup-list-command
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	940 - (command-and-args signature #:key (properties '()) #:rest body)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	941 - "Same as `define-markup-command', but defines a command that, when
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	942 -interpreted, returns a list of stencils instead of a single one"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	943 - (let* ((command (car command-and-args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	944 - (args (cdr command-and-args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	945 - (command-name (string->symbol (format #f "~a-markup-list" command)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	946 - (make-markup-name (string->symbol (format #f "make-~a-markup-list" command))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	947 - (while (and (pair? body) (keyword? (car body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	948 - (set! body (cddr body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	949 - `(begin
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	950 - ;; define the COMMAND-markup-list function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	951 - ,(let* ((documentation (if (string? (car body))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	952 - (list (car body))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	953 - '()))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	954 - (real-body (if (or (null? documentation)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	955 - (null? (cdr body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	956 - body (cdr body))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	957 - `(define-public (,command-name ,@args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	958 - ,@documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	959 - (let ,(map (lambda (prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	960 - (let ((prop (car prop-spec))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	961 - (default-value (if (null? (cdr prop-spec))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	962 - #f
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	963 - (cadr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	964 - (props (cadr args)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	965 - `(,prop (chain-assoc-get ',prop ,props ,default-value))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	966 - (filter pair? properties))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	967 - ,@real-body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	968 - (set! (markup-command-signature ,command-name) (list ,@signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	969 - ;; add the command to markup-list-function-list, for markup documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	970 - (hashq-set! markup-list-functions ,command-name #t)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	971 - ;; Used properties, for markup documentation
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	972 - (hashq-set! markup-functions-properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	973 - ,command-name
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	974 - (list ,@(map (lambda (prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	975 - (cond ((symbol? prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	976 - prop-spec)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	977 - ((not (null? (cdr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	978 - `(list ',(car prop-spec) ,(cadr prop-spec)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	979 - (else
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	980 - `(list ',(car prop-spec)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	981 - (if (pair? args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	982 - properties
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	983 - (list)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	984 - ;; it's a markup-list command:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	985 - (set-object-property! ,command-name 'markup-list-command #t)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	986 - ;; define the make-COMMAND-markup-list function
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	987 - (define-public (,make-markup-name . args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	988 - (let ((sig (list ,@signature)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	989 - (list (make-markup ,command-name
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	990 - ,(symbol->string make-markup-name) sig args)))))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	991 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	992 -(define-public (make-markup markup-function make-name signature args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	993 - "Construct a markup object from @var{markup-function} and @var{args}.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	994 -Typecheck against @var{signature}, reporting @var{make-name} as the
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	995 -user-invoked function."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	996 - (let* ((arglen (length args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	997 - (siglen (length signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	998 - (error-msg (if (and (> siglen 0) (> arglen 0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	999 - (markup-argument-list-error signature args 1)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1000 - #f)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1001 - (if (or (not (= arglen siglen)) (< siglen 0) (< arglen 0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1002 - (ly:error (string-append make-name ": "
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1003 - (_ "Wrong number of arguments. Expect: ~A, found ~A: ~S"))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1004 - siglen arglen args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1005 - (if error-msg
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1006 - (ly:error
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1007 - (string-append
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1008 - make-name ": "
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1009 - (_ "Invalid argument in position ~A. Expect: ~A, found: ~S."))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1010 - (car error-msg) (cadr error-msg)(caddr error-msg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1011 - (cons markup-function args))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1012 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1013 -;;;;;;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1014 -;;; markup constructors
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1015 -;;; lilypond-like syntax for markup construction in scheme.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1016 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1017 -(use-modules (ice-9 receive))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1018 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1019 (defmacro*-public markup (#:rest body)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1020 "The `markup' macro provides a lilypond-like syntax for building markups.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1021
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1022 @@ -258,252 +37,6 @@ Use `markup*' in a \\notemode context."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1023
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1024 (car (compile-all-markup-expressions `(#:line ,body))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1025
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1026 -(defmacro-public markup (#:rest body)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1027 - "Same as `markup', for use in a \\notes block."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1028 - `(ly:export (markup ,@body)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1029 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1030 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1031 -(define (compile-all-markup-expressions expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1032 - "Return a list of canonical markups expressions, e.g.:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1033 - (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1034 - ===>
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1035 - ((make-COMMAND1-markup arg11 arg12)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1036 - (make-COMMAND2-markup arg21 arg22 arg23) ...)"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1037 - (do ((rest expr rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1038 - (markps '() markps))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1039 - ((null? rest) (reverse markps))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1040 - (receive (m r) (compile-markup-expression rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1041 - (set! markps (cons m markps))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1042 - (set! rest r))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1043 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1044 -(define (keyword->make-markup key)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1045 - "Transform a keyword, e.g. #:COMMAND, in a make-COMMAND-markup symbol."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1046 - (string->symbol (string-append "make-" (symbol->string (keyword->symbol key)) "-markup")))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1047 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1048 -(define (compile-markup-expression expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1049 - "Return two values: the first complete canonical markup expression
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1050 - found in `expr', e.g. (make-COMMAND-markup arg1 arg2 ...),
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1051 - and the rest expression."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1052 - (cond ((and (pair? expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1053 - (keyword? (car expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1054 - ;; expr === (#:COMMAND arg1 ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1055 - (let ((command (symbol->string (keyword->symbol (car expr)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1056 - (if (not (pair? (lookup-markup-command command)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1057 - (ly:error (_ "Not a markup command: ~A") command))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1058 - (let* ((sig (markup-command-signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1059 - (car (lookup-markup-command command))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1060 - (sig-len (length sig)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1061 - (do ((i 0 (1+ i))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1062 - (args '() args)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1063 - (rest (cdr expr) rest))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1064 - ((>= i sig-len)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1065 - (values (cons (keyword->make-markup (car expr)) (reverse args)) rest))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1066 - (cond ((eqv? (list-ref sig i) markup-list?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1067 - ;; (car rest) is a markup list
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1068 - (set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1069 - (set! rest (cdr rest)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1070 - (else
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1071 - ;; pick up one arg in `rest'
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1072 - (receive (a r) (compile-markup-arg rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1073 - (set! args (cons a args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1074 - (set! rest r))))))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1075 - ((and (pair? expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1076 - (pair? (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1077 - (keyword? (caar expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1078 - ;; expr === ((#:COMMAND arg1 ...) ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1079 - (receive (m r) (compile-markup-expression (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1080 - (values m (cdr expr))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1081 - ((and (pair? expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1082 - (string? (car expr))) ;; expr === ("string" ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1083 - (values `(make-simple-markup ,(car expr)) (cdr expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1084 - (else
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1085 - ;; expr === (symbol ...) or ((funcall ...) ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1086 - (values (car expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1087 - (cdr expr)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1088 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1089 -(define (compile-all-markup-args expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1090 - "Transform `expr' into markup arguments"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1091 - (do ((rest expr rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1092 - (args '() args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1093 - ((null? rest) (reverse args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1094 - (receive (a r) (compile-markup-arg rest)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1095 - (set! args (cons a args))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1096 - (set! rest r))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1097 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1098 -(define (compile-markup-arg expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1099 - "Return two values: the desired markup argument, and the rest arguments"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1100 - (cond ((null? expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1101 - ;; no more args
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1102 - (values '() '()))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1103 - ((keyword? (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1104 - ;; expr === (#:COMMAND ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1105 - ;; ==> build and return the whole markup expression
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1106 - (compile-markup-expression expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1107 - ((and (pair? (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1108 - (keyword? (caar expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1109 - ;; expr === ((#:COMMAND ...) ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1110 - ;; ==> build and return the whole markup expression(s)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1111 - ;; found in (car expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1112 - (receive (markup-expr rest-expr) (compile-markup-expression (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1113 - (if (null? rest-expr)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1114 - (values markup-expr (cdr expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1115 - (values `(list ,markup-expr ,@(compile-all-markup-args rest-expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1116 - (cdr expr)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1117 - ((and (pair? (car expr))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1118 - (pair? (caar expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1119 - ;; expr === (((foo ...) ...) ...)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1120 - (values (cons 'list (compile-all-markup-args (car expr))) (cdr expr)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1121 - (else (values (car expr) (cdr expr)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1122 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1123 -;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1124 -;;; Utilities for storing and accessing markup commands signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1125 -;;; Examples:
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1126 -;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1127 -;;; (set! (markup-command-signature raise-markup) (list number? markup?))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1128 -;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1129 -;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1130 -;;; (markup-command-signature raise-markup)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1131 -;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1132 -;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1133 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1134 -(define-public (markup-command-signature-ref markup-command)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1135 - "Return @var{markup-command}'s signature (the @code{'markup-signature}
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1136 -object property)."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1137 - (object-property markup-command 'markup-signature))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1138 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1139 -(define-public (markup-command-signature-set! markup-command signature)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1140 - "Set @var{markup-command}'s signature (as object property)."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1141 - (set-object-property! markup-command 'markup-signature signature)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1142 - signature)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1143 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1144 -(define-public markup-command-signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1145 - (make-procedure-with-setter markup-command-signature-ref
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1146 - markup-command-signature-set!))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1147 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1148 -(define (lookup-markup-command-aux symbol)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1149 - (let ((proc (catch 'misc-error
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1150 - (lambda ()
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1151 - (module-ref (current-module) symbol))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1152 - (lambda (key . args) #f))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1153 - (and (procedure? proc) proc)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1154 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1155 -(define-public (lookup-markup-command code)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1156 - (let ((proc (lookup-markup-command-aux
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1157 - (string->symbol (format #f "~a-markup" code)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1158 - (and proc (markup-function? proc)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1159 - (cons proc (markup-command-signature proc)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1160 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1161 -(define-public (lookup-markup-list-command code)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1162 - (let ((proc (lookup-markup-command-aux
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1163 - (string->symbol (format #f "~a-markup-list" code)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1164 - (and proc (markup-list-function? proc)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1165 - (cons proc (markup-command-signature proc)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1166 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1167 -;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1168 -;;; used in parser.yy to map a list of markup commands on markup arguments
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1169 -(define-public (map-markup-command-list commands markups)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1170 - "@var{markups} being a list of markups, for example
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1171 -@code{(markup1 markup2 markup3)}, and @var{commands} a list of commands with
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1172 -their scheme arguments, in reverse order, for example
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1173 -@code{((italic) (raise 4) (bold))}, map the commands on each markup argument,
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1174 -for example
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1175 -@example
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1176 -((bold (raise 4 (italic markup1)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1177 - (bold (raise 4 (italic markup2)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1178 - (bold (raise 4 (italic markup3))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1179 -@end example"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1180 - (map-in-order (lambda (arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1181 - (let ((result arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1182 - (for-each (lambda (cmd)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1183 - (set! result (append cmd (list result))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1184 - commands)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1185 - result))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1186 - markups))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1187 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1188 -;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1189 -;;; markup type predicates
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1190 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1191 -(define (markup-function? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1192 - (and (markup-command-signature x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1193 - (not (object-property x 'markup-list-command))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1194 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1195 -(define (markup-list-function? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1196 - (and (markup-command-signature x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1197 - (object-property x 'markup-list-command)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1198 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1199 -(define-public (markup-command-list? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1200 - "Determine whether @var{x} is a markup command list, i.e. a list
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1201 -composed of a markup list function and its arguments."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1202 - (and (pair? x) (markup-list-function? (car x))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1203 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1204 -(define-public (markup-list? arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1205 - "Return @code{#t} if @var{x} is a list of markups or markup command lists."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1206 - (define (markup-list-inner? lst)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1207 - (or (null? lst)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1208 - (and (or (markup? (car lst)) (markup-command-list? (car lst)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1209 - (markup-list-inner? (cdr lst)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1210 - (not (not (and (list? arg) (markup-list-inner? arg)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1211 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1212 -(define (markup-argument-list? signature arguments)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1213 - "Typecheck argument list."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1214 - (if (and (pair? signature) (pair? arguments))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1215 - (and ((car signature) (car arguments))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1216 - (markup-argument-list? (cdr signature) (cdr arguments)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1217 - (and (null? signature) (null? arguments))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1218 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1219 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1220 -(define (markup-argument-list-error signature arguments number)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1221 - "return (ARG-NR TYPE-EXPECTED ARG-FOUND) if an error is detected, or
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1222 -#f is no error found.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1223 -"
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1224 - (if (and (pair? signature) (pair? arguments))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1225 - (if (not ((car signature) (car arguments)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1226 - (list number (type-name (car signature)) (car arguments))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1227 - (markup-argument-list-error (cdr signature) (cdr arguments) (+ 1 number)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1228 - #f))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1229 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1230 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1231 -;; full recursive typecheck.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1232 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1233 -(define (markup-typecheck? arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1234 - (or (string? arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1235 - (and (pair? arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1236 - (markup-function? (car arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1237 - (markup-argument-list? (markup-command-signature (car arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1238 - (cdr arg)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1239 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1240 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1241 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1242 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1243 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1244 -(define (markup-thrower-typecheck arg)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1245 - "typecheck, and throw an error when something amiss.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1246 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1247 -Uncovered - cheap-markup? is used."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1248 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1249 - (cond ((string? arg) #t)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1250 - ((not (pair? arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1251 - (throw 'markup-format "Not a pair" arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1252 - ((not (markup-function? (car arg)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1253 - (throw 'markup-format "Not a markup function " (car arg)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1254 - ((not (markup-argument-list? (markup-command-signature (car arg))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1255 - (cdr arg)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1256 - (throw 'markup-format "Arguments failed typecheck for " arg)))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1257 - #t)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1258 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1259 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1260 -;; good enough if you only use make-XXX-markup functions.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1261 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1262 -(define (cheap-markup? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1263 - (or (string? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1264 - (and (pair? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1265 - (markup-function? (car x)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1266 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1267 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1268 -;; replace by markup-thrower-typecheck for more detailed diagnostics.
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1269 -;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1270 -(define-public markup? cheap-markup?)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1271 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1272 ;; utility
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1273
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1274 (define (markup-join markups sep)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1275 diff --git a/scm/output-lib.scm b/scm/output-lib.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1276 index 27c69fd..5fd9c4c 100644
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1277 --- a/scm/output-lib.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1278 +++ b/scm/output-lib.scm
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1279 @@ -388,37 +388,6 @@ and duration-log @var{log}."
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1280 (make-simple-markup (format "~a" num))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1281 (markup #:fontsize -5 #:note numeratornote UP)))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1282
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1283 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1284 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1285 -;; Color
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1286 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1287 -(define-public (color? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1288 - (and (list? x)
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1289 - (= 3 (length x))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1290 - (apply eq? #t (map number? x))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1291 - (apply eq? #t (map (lambda (y) (<= 0 y 1)) x))))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1292 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1293 -(define-public (rgb-color r g b) (list r g b))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1294 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1295 -; predefined colors
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1296 -(define-public black '(0.0 0.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1297 -(define-public white '(1.0 1.0 1.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1298 -(define-public red '(1.0 0.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1299 -(define-public green '(0.0 1.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1300 -(define-public blue '(0.0 0.0 1.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1301 -(define-public cyan '(0.0 1.0 1.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1302 -(define-public magenta '(1.0 0.0 1.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1303 -(define-public yellow '(1.0 1.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1304 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1305 -(define-public grey '(0.5 0.5 0.5))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1306 -(define-public darkred '(0.5 0.0 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1307 -(define-public darkgreen '(0.0 0.5 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1308 -(define-public darkblue '(0.0 0.0 0.5))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1309 -(define-public darkcyan '(0.0 0.5 0.5))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1310 -(define-public darkmagenta '(0.5 0.0 0.5))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1311 -(define-public darkyellow '(0.5 0.5 0.0))
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1312 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1313 -
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1314 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1315 ;; key signature
2c57f92179f2 guile: more build and mingw patches. Jan Nieuwenhuizen <janneke@gnu.org> parents: diff changeset	1316

Mercurial > gub

annotate patches/lilypond-guile-2.0.patch @ 6500:2c57f92179f2