From 75b6979fb22f371780cefb6738b9ca56f1902b73 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Fri, 10 Jul 2015 01:35:25 +0200 Subject: [PATCH] Issue 4488/1: Add ly:set-origin! for setting music origins Also gives ly:music-deep-copy an optional origin argument. --- lily/include/music.hh | 4 ++- lily/music-scheme.cc | 70 +++++++++++++++++++++++++++++-------------- lily/music.cc | 39 +++++++++++++++++++++++- lily/stream-event.cc | 2 +- 4 files changed, 90 insertions(+), 25 deletions(-) diff --git a/lily/include/music.hh b/lily/include/music.hh index 7c23ee21f8..b25ead9de5 100644 --- a/lily/include/music.hh +++ b/lily/include/music.hh @@ -70,7 +70,9 @@ protected: }; Music *make_music_by_name (SCM sym); -SCM ly_music_deep_copy (SCM); +SCM music_deep_copy (SCM m); +void set_origin (SCM m, SCM origin); + SCM ly_camel_case_2_lisp_identifier (SCM name_sym); extern SCM ly_music_p_proc; diff --git a/lily/music-scheme.cc b/lily/music-scheme.cc index 16959dbfb3..de5442e966 100644 --- a/lily/music-scheme.cc +++ b/lily/music-scheme.cc @@ -20,6 +20,8 @@ #include "music.hh" #include "duration.hh" +#include "input.hh" +#include "lily-imports.hh" #include "program-option.hh" #include "warn.hh" @@ -115,30 +117,55 @@ LY_DEFINE (ly_music_list_p, "ly:music-list?", } LY_DEFINE (ly_music_deep_copy, "ly:music-deep-copy", - 1, 0, 0, (SCM m), + 1, 1, 0, (SCM m, SCM origin), "Copy @var{m} and all sub expressions of@tie{}@var{m}." " @var{m} may be an arbitrary type; cons cells and music" - " are copied recursively.") + " are copied recursively. If @var{origin} is given," + " it is used as the origin for one level of music by calling" + " @code{ly:set-origin!} on the copy.") { - if (unsmob (m)) - return unsmob (m)->clone ()->unprotect (); - if (scm_is_pair (m)) - { - SCM copy = SCM_EOL; - do - { - copy = scm_cons (ly_music_deep_copy (scm_car (m)), copy); - m = scm_cdr (m); - } - while (scm_is_pair (m)); - // Oh, come on, GUILE. Why do you require the second argument - // of scm_reverse_x to be a proper list? That makes no sense. - // return scm_reverse_x (copy, ly_music_deep_copy (m)); - SCM last_cons = copy; - copy = scm_reverse_x (copy, SCM_EOL); - scm_set_cdr_x (last_cons, ly_music_deep_copy (m)); - return copy; - } + m = music_deep_copy (m); + + if (SCM_UNBNDP (origin)) + return m; + + if (Music *mus = unsmob (origin)) + origin = mus->get_property ("origin"); + + if (scm_is_false (origin) || scm_is_null (origin)) + return m; + + LY_ASSERT_SMOB (Input, origin, 2); + + set_origin (m, origin); + return m; +} + +LY_DEFINE (ly_set_origin_x, "ly:set-origin!", + 1, 1, 0, (SCM m, SCM origin), + "This sets the origin given in @var{origin} to @var{m}. " + " @var{m} will typically be a music expression or a list" + " of music. List structures are searched recursively," + " but recursion stops at the changed music expressions" + " themselves. " + " @var{origin} is generally of type @code{ly:input-location?}," + " defaulting to @code{(*location*)}. Other valid values for" + " @code{origin} are a music expression which is then used as" + " the source of location information, or @code{#f}" + " or @code{'()} in which case no action is performed. " + " The return value is @var{m} itself.") +{ + if (SCM_UNBNDP (origin)) + origin = scm_fluid_ref (Lily::f_location); + else if (Music *mus = unsmob (origin)) + origin = mus->get_property ("origin"); + + if (scm_is_false (origin) || scm_is_null (origin)) + return m; + + LY_ASSERT_SMOB (Input, origin, 2); + + set_origin (m, origin); return m; } @@ -268,4 +295,3 @@ LY_DEFINE (ly_transpose_key_alist, "ly:transpose-key-alist", } return scm_reverse_x (newlist, SCM_EOL); } - diff --git a/lily/music.cc b/lily/music.cc index a1accb9c3d..60d33436b9 100644 --- a/lily/music.cc +++ b/lily/music.cc @@ -68,7 +68,7 @@ Music::derived_mark () const SCM Music::copy_mutable_properties () const { - return ly_music_deep_copy (mutable_property_alist_); + return music_deep_copy (mutable_property_alist_); } void @@ -329,3 +329,40 @@ Music::duration_length_callback (SCM m) mom = d->get_length (); return mom.smobbed_copy (); } + +SCM +music_deep_copy (SCM m) +{ + if (Music *mus = unsmob (m)) + return mus->clone ()->unprotect (); + if (scm_is_pair (m)) + { + SCM copy = SCM_EOL; + do + { + copy = scm_cons (music_deep_copy (scm_car (m)), copy); + m = scm_cdr (m); + } + while (scm_is_pair (m)); + // Oh, come on, GUILE. Why do you require the second argument + // of scm_reverse_x to be a proper list? That makes no sense. + // return scm_reverse_x (copy, music_deep_copy (m)); + SCM last_cons = copy; + copy = scm_reverse_x (copy, SCM_EOL); + scm_set_cdr_x (last_cons, music_deep_copy (m)); + return copy; + } + return m; +} + +void +set_origin (SCM m, SCM origin) +{ + while (scm_is_pair (m)) + { + set_origin (scm_car (m), origin); + m = scm_cdr (m); + } + if (Music *mus = unsmob (m)) + mus->set_property ("origin", origin); +} diff --git a/lily/stream-event.cc b/lily/stream-event.cc index 82bcfd8db8..64c9a979d9 100644 --- a/lily/stream-event.cc +++ b/lily/stream-event.cc @@ -92,7 +92,7 @@ Stream_event::make_transposable () || (scm_is_eq (prop, ly_symbol2scm ("pitch-alist")) && scm_is_pair (val))) && scm_is_false (scm_assq (prop, mutable_property_alist_))) mutable_property_alist_ - = scm_acons (prop, ly_music_deep_copy (val), mutable_property_alist_); + = scm_acons (prop, music_deep_copy (val), mutable_property_alist_); } } -- 2.39.5