Allow music with layout instructions in output definitions.

This allows things like

  \layout { \accidentalStyle modern }

or

  \midi { \tempo 4 = 80 }

to work as intended.

diff --git a/lily/context-def.cc b/lily/context-def.cc
index 1bea3ea4403c33abb7f6b6e1bc81bc625fffb894..9b9628c6dcf0ea32e6cb9580975131f2eb14a07c 100644 (file)
--- 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 ec737a1308e2c54063055922dc76c7233963e88a..8f4218745bec8e05862ee040e787a459331585e2 100644 (file)
--- 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 c26f2aae63806f409a745a9f08eb84868df209ba..4726a0fd5fd082105b0aa625f03fed6ce70ae521 100644 (file)
--- 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 2419940c0b52b5f28d69b9ce750ba1983ea1b40a..c8671b5ef79799351982dfd5996bfc1bc9459979 100644 (file)
--- 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 eb537a8e7183b66238158bc047e92b5c85206dda..a9098fd1f8520dc96011897d31bc7f4e8e4199fd 100644 (file)
--- 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