X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily-library.scm;h=514f5b40fb576f37ee1ad5321b0e4d83388dc74a;hb=70365334614c31a82e9a3860c9eb9334cdc2879a;hp=8d4e0a069fa5461b658678b344422d4ffe72bb37;hpb=46a3f814c8d750e4ee28a63afa5274b93e2bb058;p=lilypond.git

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)