From e995ed461610c2bb9c9cd43eaa715905b8525b95 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Sun, 26 Feb 2012 19:16:00 +0100 Subject: [PATCH] Allow music with layout instructions in output definitions. This allows things like \layout { \accidentalStyle modern } or \midi { \tempo 4 = 80 } to work as intended. --- lily/context-def.cc | 65 +++++++++++++++++++++++++++++++++++-- lily/include/context-def.hh | 1 + lily/parser.yy | 4 +++ ly/declarations-init.ly | 1 + scm/lily-library.scm | 65 +++++++++++++++++++++++++++++++++++++ 5 files changed, 134 insertions(+), 2 deletions(-) diff --git a/lily/context-def.cc b/lily/context-def.cc index 1bea3ea440..9b9628c6dc 100644 --- a/lily/context-def.cc +++ b/lily/context-def.cc @@ -23,6 +23,7 @@ #include "context-def.hh" #include "context.hh" +#include "context-mod.hh" #include "international.hh" #include "output-def.hh" #include "translator.hh" @@ -83,6 +84,7 @@ Context_def::~Context_def () #include "ly-smobs.icc" IMPLEMENT_SMOBS (Context_def); IMPLEMENT_DEFAULT_EQUAL_P (Context_def); +IMPLEMENT_TYPE_P (Context_def, "ly:context-def?"); int Context_def::print_smob (SCM smob, SCM port, scm_print_state *) @@ -349,6 +351,65 @@ Context_def::to_alist () const return ell; } -#include "ly-smobs.icc" +SCM +Context_def::lookup (SCM sym) const +{ + if (scm_is_eq (ly_symbol2scm ("default-child"), sym)) + return default_child_; + else if (scm_is_eq (ly_symbol2scm ("consists"), sym)) + return get_translator_names (SCM_EOL); + else if (scm_is_eq (ly_symbol2scm ("description"), sym)) + return description_; + else if (scm_is_eq (ly_symbol2scm ("aliases"), sym)) + return context_aliases_; + else if (scm_is_eq (ly_symbol2scm ("accepts"), sym)) + return get_accepted (SCM_EOL); + else if (scm_is_eq (ly_symbol2scm ("property-ops"), sym)) + return property_ops_; + else if (scm_is_eq (ly_symbol2scm ("context-name"), sym)) + return context_name_; + else if (scm_is_eq (ly_symbol2scm ("group-type"), sym)) + return translator_group_type_; + return SCM_UNDEFINED; +} -IMPLEMENT_TYPE_P (Context_def, "ly:context-def?"); +LY_DEFINE (ly_context_def_lookup, "ly:context-def-lookup", + 2, 1, 0, (SCM def, SCM sym, SCM val), + "Return the value of @var{sym} in output definition @var{def}" + " (e.g., @code{\\paper}). If no value is found, return" + " @var{val} or @code{'()} if @var{val} is undefined.") +{ + LY_ASSERT_SMOB (Context_def, def, 1); + Context_def *cd = unsmob_context_def (def); + LY_ASSERT_TYPE (ly_is_symbol, sym, 2); + + SCM res = cd->lookup (sym); + + scm_remember_upto_here_1 (def); + + if (SCM_UNBNDP (res)) + res = SCM_EOL; + + if (scm_is_null (res) && !SCM_UNBNDP (val)) + return val; + + return res; +} + +LY_DEFINE (ly_context_def_modify, "ly:context-def-modify", + 2, 0, 0, (SCM def, SCM mod), + "Return the result of applying the context-mod @var{mod} to" + " the context definition @var{def}. Does not change @var{def}.") +{ + LY_ASSERT_SMOB (Context_def, def, 1); + LY_ASSERT_SMOB (Context_mod, mod, 2); + + Context_def *cd = unsmob_context_def (def)->clone (); + + for (SCM s = unsmob_context_mod (mod)->get_mods (); + scm_is_pair (s); + s = scm_cdr (s)) + cd->add_context_mod (scm_car (s)); + + return cd->unprotect (); +} diff --git a/lily/include/context-def.hh b/lily/include/context-def.hh index ec737a1308..8f4218745b 100644 --- a/lily/include/context-def.hh +++ b/lily/include/context-def.hh @@ -56,6 +56,7 @@ public: SCM get_translator_names (SCM) const; SCM get_translator_group_type () const { return translator_group_type_; } void set_acceptor (SCM accepts, bool add); + SCM lookup (SCM sym) const; VIRTUAL_COPY_CONSTRUCTOR (Context_def, Context_def); diff --git a/lily/parser.yy b/lily/parser.yy index c26f2aae63..4726a0fd5f 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -1080,6 +1080,10 @@ output_def_body: | output_def_body context_def_spec_block { assign_context_def ($$, $2); } + | output_def_body music_arg { + SCM proc = parser->lexer_->lookup_identifier ("output-def-music-handler"); + scm_call_3 (proc, parser->self_scm (), $1->self_scm (), $2); + } | output_def_body error { } diff --git a/ly/declarations-init.ly b/ly/declarations-init.ly index 2419940c0b..c8671b5ef7 100644 --- a/ly/declarations-init.ly +++ b/ly/declarations-init.ly @@ -114,6 +114,7 @@ repeatTie = #(make-music 'RepeatTieEvent) #(define bookpart-score-handler ly:book-add-score!) #(define bookpart-text-handler ly:book-add-score!) #(define bookpart-music-handler collect-book-music-for-book) +#(define output-def-music-handler context-defs-from-music) \include "predefined-fretboards-init.ly" \include "string-tunings-init.ly" diff --git a/scm/lily-library.scm b/scm/lily-library.scm index eb537a8e71..a9098fd1f8 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -257,6 +257,71 @@ bookoutput function" parser music)) +(define-public (context-defs-from-music parser output-def music) + (let ((bottom 'Voice) (warn #t)) + (define (get-bottom sym) + (or + (let ((def (ly:output-def-lookup output-def sym #f))) + (and def + (let ((def-child (ly:context-def-lookup def 'default-child #f))) + (and def-child + (get-bottom def-child))))) + sym)) + (let loop ((m music) (mods #f)) + ;; The parser turns all sets, overrides etc into something + ;; wrapped in ContextSpeccedMusic. If we ever get a set, + ;; override etc that is not wrapped in ContextSpeccedMusic, the + ;; user has created it in Scheme himself without providing the + ;; required wrapping. In that case, using #f in the place of a + ;; context modification results in a reasonably recognizable + ;; error. + (if (music-is-of-type? m 'layout-instruction-event) + (ly:add-context-mod + mods + (case (ly:music-property m 'name) + ((PropertySet) + (list 'assign + (ly:music-property m 'symbol) + (ly:music-property m 'value))) + ((PropertyUnset) + (list 'unset + (ly:music-property m 'symbol))) + ((OverrideProperty) + (list 'push + (ly:music-property m 'symbol) + (ly:music-property m 'grob-value) + (ly:music-property m 'grob-property-path))) + ((RevertProperty) + (list 'pop + (ly:music-property m 'symbol) + (ly:music-property m 'grob-property-path))))) + (case (ly:music-property m 'name) + ((SequentialMusic SimultaneousMusic) + (fold loop mods (ly:music-property m 'elements))) + ((ContextSpeccedMusic) + (let ((sym (ly:music-property m 'context-type))) + (if (eq? sym 'Bottom) + (set! sym bottom) + (set! bottom (get-bottom sym))) + (let ((def (ly:output-def-lookup output-def sym))) + (if (ly:context-def? def) + (ly:output-def-set-variable! + output-def sym + (ly:context-def-modify + def + (loop (ly:music-property m 'element) + (ly:make-context-mod)))) + (ly:music-warning + music + (ly:format (_ "Cannot find context-def \\~a") sym)))))) + (else (if (and warn (ly:duration? (ly:music-property m 'duration))) + (begin + (ly:music-warning + music + (_ "Music unsuitable for output-def")) + (set! warn #f)))))) + mods))) + ;;;;;;;;;;;;;;;; ;; alist -- 2.39.2