Allow music in contextmods

diff --git a/lily/context-property.cc b/lily/context-property.cc
index 0c5e1ec55d689850efeeaf7eef209c4d2c4c3f32..be27388eaeb17688f2604e899725268ae567de21 100644 (file)
--- 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 4726a0fd5fd082105b0aa625f03fed6ce70ae521..601d63fc31e5586ad9016195f48d031644a8549b 100644 (file)
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -459,6 +459,8 @@ If we give names, Bison complains.
 %type <scm> context_def_spec_block
 %type <scm> context_def_spec_body
 %type <scm> context_mod
+%type <scm> context_mod_arg
+%type <scm> context_mod_embedded
 %type <scm> context_mod_list
 %type <scm> context_prop_spec
 %type <scm> 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 c8671b5ef79799351982dfd5996bfc1bc9459979..45b1b87fa1c234131ad9c9718fc59b02c3524768 100644 (file)
--- 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 8d4e0a069fa5461b658678b344422d4ffe72bb37..514f5b40fb576f37ee1ad5321b0e4d83388dc74a 100644 (file)
--- 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)