From: David Kastrup Date: Fri, 9 Mar 2012 23:15:01 +0000 (+0100) Subject: Allow music in contextmods X-Git-Tag: release/2.15.34-1~16 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=70365334614c31a82e9a3860c9eb9334cdc2879a;p=lilypond.git Allow music in contextmods --- diff --git a/lily/context-property.cc b/lily/context-property.cc index 0c5e1ec55d..be27388eae 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -230,25 +230,32 @@ apply_property_operations (Context *tg, SCM pre_init_ops) SCM entry = scm_car (s); SCM type = scm_car (entry); entry = scm_cdr (entry); + if (!scm_is_pair (entry)) + continue; + SCM context_prop = scm_car (entry); + if (scm_is_pair (context_prop)) { + if (tg->is_alias (scm_car (context_prop))) + context_prop = scm_cdr (context_prop); + else + continue; + } if (type == ly_symbol2scm ("push")) { - SCM context_prop = scm_car (entry); SCM val = scm_cadr (entry); SCM grob_prop_path = scm_cddr (entry); sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val); } else if (type == ly_symbol2scm ("pop")) { - SCM context_prop = scm_car (entry); SCM val = SCM_UNDEFINED; SCM grob_prop_path = scm_cdr (entry); sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val); } else if (type == ly_symbol2scm ("assign")) - tg->set_property (scm_car (entry), scm_cadr (entry)); + tg->set_property (context_prop, scm_cadr (entry)); else if (type == ly_symbol2scm ("apply")) - scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry)); + scm_apply_1 (context_prop, tg->self_scm (), scm_cdr (entry)); } } diff --git a/lily/parser.yy b/lily/parser.yy index 4726a0fd5f..601d63fc31 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -459,6 +459,8 @@ If we give names, Bison complains. %type context_def_spec_block %type context_def_spec_body %type context_mod +%type context_mod_arg +%type context_mod_embedded %type context_mod_list %type context_prop_spec %type direction_less_char @@ -808,6 +810,27 @@ context_def_spec_block: } ; +context_mod_arg: + embedded_scm + | composite_music + ; + +context_mod_embedded: + context_mod_arg + { + if (unsmob_music ($1)) { + SCM proc = parser->lexer_->lookup_identifier ("context-mod-music-handler"); + $1 = scm_call_2 (proc, parser->self_scm (), $1); + } + if (unsmob_context_mod ($1)) + $$ = $1; + else { + parser->parser_error (@1, _ ("not a context mod")); + } + } + ; + + context_def_spec_body: /**/ { $$ = Context_def::make_scm (); @@ -817,18 +840,6 @@ context_def_spec_body: $$ = $1; unsmob_context_def ($$)->origin ()->set_spot (@$); } - | context_def_spec_body embedded_scm { - if (Context_mod *cm = unsmob_context_mod ($2)) { - SCM p = cm->get_mods (); - Context_def*td = unsmob_context_def ($$); - - for (; scm_is_pair (p); p = scm_cdr (p)) { - td->add_context_mod (scm_car (p)); - } - } else { - parser->parser_error (@2, _ ("not a context mod")); - } - } | context_def_spec_body context_mod { unsmob_context_def ($$)->add_context_mod ($2); } @@ -839,6 +850,13 @@ context_def_spec_body: td->add_context_mod (scm_car (m)); } } + | context_def_spec_body context_mod_embedded { + Context_def *td = unsmob_context_def ($$); + SCM new_mods = unsmob_context_mod ($2)->get_mods (); + for (SCM m = new_mods; scm_is_pair (m); m = scm_cdr (m)) { + td->add_context_mod (scm_car (m)); + } + } ; @@ -1236,12 +1254,9 @@ context_mod_list: if (md) unsmob_context_mod ($1)->add_context_mods (md->get_mods ()); } - | context_mod_list embedded_scm { - Context_mod *md = unsmob_context_mod ($2); - if (md) - unsmob_context_mod ($1)->add_context_mods (md->get_mods ()); - else - parser->parser_error (@2, _ ("not a context mod")); + | context_mod_list context_mod_embedded { + unsmob_context_mod ($1)->add_context_mods + (unsmob_context_mod ($2)->get_mods ()); } ; diff --git a/ly/declarations-init.ly b/ly/declarations-init.ly index c8671b5ef7..45b1b87fa1 100644 --- a/ly/declarations-init.ly +++ b/ly/declarations-init.ly @@ -115,6 +115,7 @@ repeatTie = #(make-music 'RepeatTieEvent) #(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) +#(define context-mod-music-handler context-mod-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 8d4e0a069f..514f5b40fb 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -257,6 +257,48 @@ bookoutput function" parser music)) +(define-public (context-mod-from-music parser music) + (let ((warn #t) (mods (ly:make-context-mod))) + (let loop ((m music) (context #f)) + (if (music-is-of-type? m 'layout-instruction-event) + (let ((symbol (cons context (ly:music-property m 'symbol)))) + (ly:add-context-mod + mods + (case (ly:music-property m 'name) + ((PropertySet) + (list 'assign + symbol + (ly:music-property m 'value))) + ((PropertyUnset) + (list 'unset symbol)) + ((OverrideProperty) + (cons* 'push + symbol + (ly:music-property m 'grob-value) + (ly:music-property m 'grob-property-path))) + ((RevertProperty) + (cons* 'pop + symbol + (ly:music-property m 'grob-property-path)))))) + (case (ly:music-property m 'name) + ((ApplyContext) + (ly:add-context-mod mods + (list 'apply + (ly:music-property m 'procedure)))) + ((SequentialMusic SimultaneousMusic) + (fold loop context (ly:music-property m 'elements))) + ((ContextSpeccedMusic) + (loop (ly:music-property m 'element) + (ly:music-property m 'context-type))) + (else (if (and warn (ly:duration? (ly:music-property m 'duration))) + (begin + (ly:music-warning + music + (_ "Music unsuitable for context-mod")) + (set! warn #f)))))) + context) + mods)) + (define-public (context-defs-from-music parser output-def music) (let ((bottom 'Voice) (warn #t)) (define (get-bottom sym)