From 83e6304ae3cc708a8e4d0462249ca8babae265a3 Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Mon, 21 Nov 2011 01:05:07 +0100
Subject: [PATCH] Add Scheme context-mods, reimplement \grobdescriptions, add
 \settingsFrom

\settingsFrom translates music with layout instructions (\set, \unset,
\override, \revert) into a context modification.  That way, you can use most
of the definitions from ly/property-init.ly as context modifications.
---
 lily/lily-lexer.cc         |  1 -
 lily/parser.yy             | 27 ++++++++++++++-------
 ly/music-functions-init.ly | 48 +++++++++++++++++++++++++++++++++++++-
 3 files changed, 65 insertions(+), 11 deletions(-)

diff --git a/lily/lily-lexer.cc b/lily/lily-lexer.cc
index 64878444a1..35d0acdde3 100644
--- a/lily/lily-lexer.cc
+++ b/lily/lily-lexer.cc
@@ -58,7 +58,6 @@ static Keyword_ent the_key_tab[]
   {"drums", DRUMS},
   {"figuremode", FIGUREMODE},
   {"figures", FIGURES},
-  {"grobdescriptions", GROBDESCRIPTIONS},
   {"header", HEADER},
   {"layout", LAYOUT},
   {"lyricmode", LYRICMODE},
diff --git a/lily/parser.yy b/lily/parser.yy
index a4da7e2e30..d98780c374 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -247,7 +247,6 @@ void set_music_properties (Music *p, SCM a);
 %token DRUMS "\\drums"
 %token FIGUREMODE "\\figuremode"
 %token FIGURES "\\figures"
-%token GROBDESCRIPTIONS "\\grobdescriptions"
 %token HEADER "\\header"
 %token INVALID "\\version-error"
 %token LAYOUT "\\layout"
@@ -815,15 +814,16 @@ context_def_spec_body:
 		$$ = $1;
 		unsmob_context_def ($$)->origin ()->set_spot (@$);
 	}
-	| context_def_spec_body GROBDESCRIPTIONS embedded_scm {
-		Context_def*td = unsmob_context_def ($$);
+	| 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 p = $3; scm_is_pair (p); p = scm_cdr (p)) {
-			SCM tag = scm_caar (p);
-
-			/* TODO: should make new tag "grob-definition" ? */
-			td->add_context_mod (scm_list_3 (ly_symbol2scm ("assign"),
-							tag, scm_cons (scm_cdar (p), SCM_EOL)));
+			for (; scm_is_pair (p); p = scm_cdr (p)) {
+				td->add_context_mod (scm_car (p));
+			}
+		} else {
+			PARSER->parser_error (@2, "context-mod expected");
 		}
 	}
 	| context_def_spec_body context_mod {
@@ -1184,6 +1184,15 @@ context_modification:
         {
                 $$ = $1;
         }
+	| WITH embedded_scm_closed
+	{
+		if (unsmob_context_mod ($2))
+			$$ = $2;
+		else {
+			PARSER->parser_error (@2, "context-mod expected");
+			$$ = Context_mod ().smobbed_copy ();
+		}
+	}
         ;
 
 optional_context_mod:
diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index 3b3a5b4c3a..8b5cddf013 100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -402,6 +402,15 @@ grace =
 #(def-grace-function startGraceMusic stopGraceMusic
    (_i "Insert @var{music} as grace notes."))
 
+grobdescriptions =
+#(define-scheme-function (parser location descriptions) (list?)
+   (_i "Create a context modification from @var{descriptions}, a list
+in the format of @code{all-grob-descriptions}.")
+   (ly:make-context-mod
+    (map (lambda (p)
+	   (list 'assign (car p) (list (cdr p))))
+	 descriptions)))
+
 harmonicByFret = #(define-music-function (parser location fret music) (number? ly:music?)
   (_i "Convert @var{music} into harmonics; the resulting notes resemble
 harmonics played on a fretted instrument by touching the strings above @var{fret}.")
@@ -974,6 +983,44 @@ scaleDurations =
    (ly:music-compress music
 		      (ly:make-moment (car fraction) (cdr fraction))))
 
+settingsFrom =
+#(define-scheme-function (parser location ctx music)
+   ((symbol?) ly:music?)
+   (_i "Take the layout instruction events from @var{music}, optionally
+restricted to those applying to context type @var{ctx}, and return
+a context modification duplicating their effect.")
+   (let ((mods (ly:make-context-mod)))
+     (define (musicop m)
+       (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-property-path)
+		     (ly:music-property m 'grob-value)))
+	      ((RevertProperty)
+	       (list 'pop
+		     (ly:music-property m 'symbol)
+		     (ly:music-property m 'grob-property-path)))))
+	   (case (ly:music-property m 'name)
+	     ((SequentialMusic SimultaneousMusic)
+	      (for-each musicop (ly:music-property m 'elements)))
+	     ((ContextSpeccedMusic)
+	      (if (or (not ctx)
+		      (eq? ctx (ly:music-property m 'context-type)))
+		  (musicop (ly:music-property m 'element)))))))
+     (musicop music)
+     mods))
+
 shiftDurations =
 #(define-music-function (parser location dur dots arg)
    (integer? integer? ly:music?)
@@ -1117,7 +1164,6 @@ void =
 Use this if you want to have a scheme expression evaluated
 because of its side-effects, but its value ignored."))
 
-
 withMusicProperty =
 #(define-music-function (parser location sym val music)
    (symbol? scheme? ly:music?)
-- 
2.39.2